From 5cf2973715fce14e5586e63037deacb75cd13fae Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 14:53:40 +0200 Subject: [PATCH 01/41] naming reflect change from Piola-Kirchhoff to Mandel stress not using the symmetrized stress anymore to avoid handling of symmetrized Schmid matrizes. The time saved when calculating the double contraction is probably anyway lost during the conversion from (3,3) to (6) of Mstar --- src/constitutive.f90 | 8 +++-- src/plastic_phenopowerlaw.f90 | 58 ++++++++++++++++++++--------------- 2 files changed, 39 insertions(+), 27 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9c3989a9c..1db467974 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -482,7 +482,8 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v real(pReal), dimension(9,9) :: & dLp_dMstar !< derivative of Lp with respect to Mstar (4th-order tensor) real(pReal), dimension(3,3) :: & - temp_33 + temp_33, & + Mstar integer(pInt) :: & ho, & !< homogenization tme !< thermal member position @@ -492,7 +493,8 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v ho = material_homog(ip,el) tme = thermalMapping(ho)%p(ip,el) - Mstar_v = math_Mandel33to6(math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(Tstar_v))) + Mstar = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(Tstar_v)) + Mstar_v = math_Mandel33to6(Mstar) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_NONE_ID) plasticityType @@ -501,7 +503,7 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v case (PLASTICITY_ISOTROPIC_ID) plasticityType call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) + call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMstar,Mstar,ipc,ip,el) case (PLASTICITY_KINEHARDENING_ID) plasticityType call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f91ba28ae..beeb55003 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -320,7 +320,7 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase + NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase sizeState = size(['tau_slip ','accshear_slip']) * prm%TotalNslip & + size(['tau_twin ','accshear_twin']) * prm%TotalNtwin & + size(['sum(gamma)', 'sum(f) ']) @@ -357,6 +357,16 @@ subroutine plastic_phenopowerlaw_init index_myFamily = sum(prm%Nslip(1:f-1_pInt)) mySlipSystems: do j = 1_pInt,prm%Nslip(f) + !prm%Schmid_pos(1:3,1:3,index_myFamily+j) = lattice_Sslip(1:3,1:3,1,index_myFamily+j,p) + !prm%Schmid_neg(1:3,1:3,index_myFamily+j) = lattice_Sslip(1:3,1:3,2,index_myFamily+j,p) + !do k = 1,size(prm%nonSchmidCoeff) + ! prm%nonSchmid_pos(1:3,1:3,k,index_myFamily+j) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) + ! prm%nonSchmid_neg(1:3,1:3,k,index_myFamily+j) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) + ! !nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + prm%nonSchmidCoeff(k)*& + ! ! 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) + prm%nonSchmidCoeff(k)*& + ! ! lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + !enddo 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) @@ -467,17 +477,16 @@ end subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) +subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc,ip,el) use prec, only: & dNeq0 use math, only: & + math_mul33xx33,& math_Plain3333to99, & math_Mandel6to33 use lattice, only: & lattice_Sslip, & - lattice_Sslip_v, & lattice_Stwin, & - lattice_Stwin_v, & lattice_NslipSystem, & lattice_NtwinSystem use material, only: & @@ -488,15 +497,15 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, implicit none real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress + real(pReal), dimension(9,9), intent(out) :: & + dLp_dMstar99 !< derivative of Lp with respect to the Mandel stress integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3), intent(in) :: & + Mstar !< Mandel stress integer(pInt) :: & index_myFamily, & @@ -509,7 +518,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dgdot_dtauslip_pos,dgdot_dtauslip_neg, & gdot_twin,dgdot_dtautwin,tau_twin real(pReal), dimension(3,3,3,3) :: & - dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor + dLp_dMstar3333 !< derivative of Lp with respect to Mstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor type(tParameters) :: prm @@ -518,30 +527,31 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - associate(prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph))) + associate(prm => param(phase_plasticityInstance(ph)),& + stt => state(phase_plasticityInstance(ph))) Lp = 0.0_pReal - dLp_dTstar3333 = 0.0_pReal - dLp_dTstar99 = 0.0_pReal + dLp_dMstar3333 = 0.0_pReal + dLp_dMstar99 = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! Slip part j = 0_pInt slipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt ! Calculation of Lp - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_pos = math_mul33xx33(Mstar,lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos 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) do k = 1,size(prm%nonSchmidCoeff) tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + math_mul33xx33(Mstar,lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg + prm%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + math_mul33xx33(Mstar,lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph)) nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + prm%nonSchmidCoeff(k)*& 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) + prm%nonSchmidCoeff(k)*& @@ -560,7 +570,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos 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) + & + dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) + & dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & nonSchmid_tensor(m,n,1) endif @@ -568,7 +578,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, if (dNeq0(tau_slip_neg)) then dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg 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) + & + dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) + & dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & nonSchmid_tensor(m,n,2) endif @@ -584,7 +594,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, j = j+1_pInt ! Calculation of Lp - tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + tau_twin = math_mul33xx33(Mstar,lattice_Stwin(1:3,1:3,index_myFamily+i,ph)) gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*& (abs(tau_twin)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) @@ -594,14 +604,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, if (dNeq0(gdot_twin)) then dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin 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) + & + dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) + & dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & lattice_Stwin(m,n,index_myFamily+i,ph) endif enddo twinSystems enddo twinFamilies - dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) + dLp_dMstar99 = math_Plain3333to99(dLp_dMstar3333) end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent @@ -650,9 +660,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - associate( prm => param(phase_plasticityInstance(ph)), & - stt => state(phase_plasticityInstance(ph)), & - dst => dotState(phase_plasticityInstance(ph))) + associate(prm => param(phase_plasticityInstance(ph)), & + stt => state(phase_plasticityInstance(ph)), & + dst => dotState(phase_plasticityInstance(ph))) dst%whole(:,of) = 0.0_pReal From 8a32ed874782754e50eb234bf16c4367d17c4e2f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 23:03:51 +0200 Subject: [PATCH 02/41] calculating non-schmid related data only once --- src/plastic_phenopowerlaw.f90 | 78 +++++++++++++++++++++-------------- 1 file changed, 47 insertions(+), 31 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index beeb55003..6f19e7739 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -67,7 +67,14 @@ module plastic_phenopowerlaw interaction_SlipTwin, & !< slip resistance from twin activity interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity - + real(pReal), dimension(:,:,:), allocatable :: & + Schmid_pos, & + Schmid_neg, & + nonSchmid_tensor_pos, & + nonSchmid_tensor_neg + real(pReal), dimension(:,:,:,:), allocatable :: & + nonSchmid_pos, & + nonSchmid_neg integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID !< ID of each post result output end type @@ -184,7 +191,7 @@ subroutine plastic_phenopowerlaw_init instance = phase_plasticityInstance(p) associate(prm => param(instance)) - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') if (any(lattice_NslipSystem(1:size(prm%Nslip),p)-prm%Nslip < 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') prm%totalNslip = sum(prm%Nslip) @@ -204,7 +211,7 @@ subroutine plastic_phenopowerlaw_init prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') endif - prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) + prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) if (size(prm%Ntwin) > count(lattice_NtwinSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') if (any(lattice_NtwinSystem(1:size(prm%Ntwin),p)-prm%Ntwin < 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') prm%totalNtwin = sum(prm%Ntwin) @@ -229,7 +236,6 @@ subroutine plastic_phenopowerlaw_init prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') endif - prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) @@ -241,29 +247,29 @@ subroutine plastic_phenopowerlaw_init select case(outputs(i)) case ('resistance_slip') outputID = resistance_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('accumulatedshear_slip') outputID = accumulatedshear_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('shearrate_slip') outputID = shearrate_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('resolvedstress_slip') outputID = resolvedstress_slip_ID - outputSize = sum(prm%Nslip) + outputSize = prm%totalNslip case ('resistance_twin') outputID = resistance_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('accumulatedshear_twin') outputID = accumulatedshear_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('shearrate_twin') outputID = shearrate_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('resolvedstress_twin') outputID = resolvedstress_twin_ID - outputSize = sum(prm%Ntwin) + outputSize = prm%totalNtwin case ('totalvolfrac_twin') outputID = totalvolfrac_twin_ID @@ -282,7 +288,7 @@ subroutine plastic_phenopowerlaw_init end do extmsg = '' - if (sum(prm%Nslip) > 0_pInt) then + if (prm%totalNslip > 0_pInt) then if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & @@ -300,7 +306,7 @@ subroutine plastic_phenopowerlaw_init if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? endif - if (sum(prm%Ntwin) > 0_pInt) then + if (prm%totalNtwin > 0_pInt) then if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') @@ -329,8 +335,8 @@ subroutine plastic_phenopowerlaw_init plasticState(p)%sizeState = sizeState plasticState(p)%sizeDotState = sizeDotState plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) - plasticState(p)%nSlip = sum(prm%Nslip) - plasticState(p)%nTwin = sum(prm%Ntwin) + plasticState(p)%nSlip = prm%totalNslip + plasticState(p)%nTwin = prm%totalNtwin allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -351,22 +357,32 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices - allocate(temp1(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) - allocate(temp2(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) + allocate(temp1(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) + allocate(temp2(prm%totalNslip,prm%totalNtwin),source = 0.0_pReal) + allocate(prm%Schmid_pos(3,3,prm%totalNslip),source = 0.0_pReal) + allocate(prm%Schmid_neg(3,3,prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_tensor_pos(3,3,prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_tensor_neg(3,3,prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_pos(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_neg(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) + i = 0_pInt mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X index_myFamily = sum(prm%Nslip(1:f-1_pInt)) mySlipSystems: do j = 1_pInt,prm%Nslip(f) - !prm%Schmid_pos(1:3,1:3,index_myFamily+j) = lattice_Sslip(1:3,1:3,1,index_myFamily+j,p) - !prm%Schmid_neg(1:3,1:3,index_myFamily+j) = lattice_Sslip(1:3,1:3,2,index_myFamily+j,p) - !do k = 1,size(prm%nonSchmidCoeff) - ! prm%nonSchmid_pos(1:3,1:3,k,index_myFamily+j) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) - ! prm%nonSchmid_neg(1:3,1:3,k,index_myFamily+j) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) - ! !nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + prm%nonSchmidCoeff(k)*& - ! ! 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) + prm%nonSchmidCoeff(k)*& - ! ! lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) - !enddo + i = i + 1_pInt + prm%Schmid_pos(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,index_myFamily+j,p) + prm%Schmid_neg(1:3,1:3,i) = lattice_Sslip(1:3,1:3,2,index_myFamily+j,p) + prm%nonSchmid_tensor_pos(1:3,1:3,i) = prm%Schmid_pos(1:3,1:3,i) + prm%nonSchmid_tensor_neg(1:3,1:3,i) = prm%Schmid_neg(1:3,1:3,i) + do k = 1,size(prm%nonSchmidCoeff) + prm%nonSchmid_pos(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) + prm%nonSchmid_neg(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) + prm%nonSchmid_tensor_pos(1:3,1:3,i) = prm%nonSchmid_tensor_pos(1:3,1:3,i) + prm%nonSchmidCoeff(k)*& + lattice_Sslip(1:3,1:3,2*k,index_myFamily+j,p) + prm%nonSchmid_tensor_neg(1:3,1:3,i) = prm%nonSchmid_tensor_neg(1:3,1:3,i) + prm%nonSchmidCoeff(k)*& + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) + enddo 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) @@ -392,8 +408,8 @@ subroutine plastic_phenopowerlaw_init prm%interaction_SlipTwin = temp2; deallocate(temp2) - allocate(temp1(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) - allocate(temp2(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) + allocate(temp1(prm%totalNtwin,prm%totalNslip),source =0.0_pReal) + allocate(temp2(prm%totalNtwin,prm%totalNtwin),source =0.0_pReal) myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) myTwinSystems: do j = 1_pInt,prm%Ntwin(f) @@ -477,7 +493,7 @@ end subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc,ip,el) +pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc,ip,el) use prec, only: & dNeq0 use math, only: & From 1493b33a0367ea96936f4dc2d77d4601587b360c Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 14 Aug 2018 01:07:06 +0200 Subject: [PATCH 03/41] fixed buggy state width assignment (endindex += %nSlip corrected to %totalNslip) --- src/plastic_phenopowerlaw.f90 | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 5a13d371f..69c4e987b 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -440,25 +440,25 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt - endIndex = plasticState(p)%nSlip - state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + endIndex = prm%totalNslip + state (instance)%s_slip => plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_slip => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nTwin - state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + endIndex = endIndex + prm%totalNtwin + state (instance)%s_twin => plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt - state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) - dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) + state (instance)%sumGamma => plasticState(p)%state (startIndex,:) + dotState(instance)%sumGamma => plasticState(p)%dotState(startIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear startIndex = endIndex + 1_pInt @@ -468,21 +468,21 @@ subroutine plastic_phenopowerlaw_init plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nSlip - state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + endIndex = endIndex + prm%totalNslip + state (instance)%accshear_slip => plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_slip => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear ! global alias - plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) + plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nTwin - state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + endIndex = endIndex + prm%totalNtwin + state (instance)%accshear_twin => plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - dotState(instance)%whole =>plasticState(p)%dotState + dotState(instance)%whole => plasticState(p)%dotState end associate enddo From cc5d04ff2ac64adbf69a85c7d77a746464822495 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 19:28:09 +0200 Subject: [PATCH 04/41] newly introduced parameters for non-schmid were confusing --- src/plastic_phenopowerlaw.f90 | 51 ++++++++++++++--------------------- 1 file changed, 20 insertions(+), 31 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 69c4e987b..4b41acb7c 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -68,10 +68,7 @@ module plastic_phenopowerlaw interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity real(pReal), dimension(:,:,:), allocatable :: & - Schmid_pos, & - Schmid_neg, & - nonSchmid_tensor_pos, & - nonSchmid_tensor_neg + Schmid_slip real(pReal), dimension(:,:,:,:), allocatable :: & nonSchmid_pos, & nonSchmid_neg @@ -359,10 +356,7 @@ subroutine plastic_phenopowerlaw_init ! calculate hardening matrices allocate(temp1(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) allocate(temp2(prm%totalNslip,prm%totalNtwin),source = 0.0_pReal) - allocate(prm%Schmid_pos(3,3,prm%totalNslip),source = 0.0_pReal) - allocate(prm%Schmid_neg(3,3,prm%totalNslip),source = 0.0_pReal) - allocate(prm%nonSchmid_tensor_pos(3,3,prm%totalNslip),source = 0.0_pReal) - allocate(prm%nonSchmid_tensor_neg(3,3,prm%totalNslip),source = 0.0_pReal) + allocate(prm%Schmid_slip(3,3,prm%totalNslip),source = 0.0_pReal) allocate(prm%nonSchmid_pos(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) allocate(prm%nonSchmid_neg(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) i = 0_pInt @@ -371,17 +365,12 @@ subroutine plastic_phenopowerlaw_init mySlipSystems: do j = 1_pInt,prm%Nslip(f) i = i + 1_pInt - prm%Schmid_pos(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,index_myFamily+j,p) - prm%Schmid_neg(1:3,1:3,i) = lattice_Sslip(1:3,1:3,2,index_myFamily+j,p) - prm%nonSchmid_tensor_pos(1:3,1:3,i) = prm%Schmid_pos(1:3,1:3,i) - prm%nonSchmid_tensor_neg(1:3,1:3,i) = prm%Schmid_neg(1:3,1:3,i) + prm%Schmid_slip(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,index_myFamily+j,p) do k = 1,size(prm%nonSchmidCoeff) - prm%nonSchmid_pos(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) - prm%nonSchmid_neg(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) - prm%nonSchmid_tensor_pos(1:3,1:3,i) = prm%nonSchmid_tensor_pos(1:3,1:3,i) + prm%nonSchmidCoeff(k)*& - lattice_Sslip(1:3,1:3,2*k,index_myFamily+j,p) - prm%nonSchmid_tensor_neg(1:3,1:3,i) = prm%nonSchmid_tensor_neg(1:3,1:3,i) + prm%nonSchmidCoeff(k)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) + prm%nonSchmid_pos(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) & + * prm%nonSchmidCoeff(k) + prm%nonSchmid_neg(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) & + * prm%nonSchmidCoeff(k) enddo otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) @@ -559,19 +548,19 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, j = j+1_pInt ! Calculation of Lp - tau_slip_pos = math_mul33xx33(Mstar,lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph)) + tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip) tau_slip_neg = tau_slip_pos 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) do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & - math_mul33xx33(Mstar,lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + prm%nonSchmidCoeff(k)* & - math_mul33xx33(Mstar,lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + prm%nonSchmidCoeff(k)*& - 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) + prm%nonSchmidCoeff(k)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + tau_slip_pos = tau_slip_pos & + + math_mul33xx33(Mstar,prm%nonSchmidCoeff(k)*lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg & + + math_mul33xx33(Mstar,prm%nonSchmidCoeff(k)*lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph)) + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + & + prm%nonSchmidCoeff(k)*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) + & + prm%nonSchmidCoeff(k)*lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) @@ -705,10 +694,10 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + tau_slip_pos = tau_slip_pos & + + dot_product(Tstar_v,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg & + + dot_product(Tstar_v,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & From 6b8ecbe653782bc1addd5791df531738b4d9dc76 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 19:47:39 +0200 Subject: [PATCH 05/41] using only internal Schmid and nonSchmid matrix --- examples/SpectralMethod/Polycrystal/material.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 5073f165e..572b87ef4 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -55,7 +55,7 @@ a_slip 2.25 h0_slipslip 75e6 interaction_slipslip 1 1 1.4 1.4 1.4 1.4 atol_resistance 1 - +nonschmid_coefficients 0.938 0.71 4.43 0.0 0.0 0.0 #-------------------# From d055ef665ae341d7316360271844c9cf2080543c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 19:52:26 +0200 Subject: [PATCH 06/41] using only internal schmid and non schmid matrices --- src/plastic_phenopowerlaw.f90 | 28 ++++++++++------------------ 1 file changed, 10 insertions(+), 18 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 4b41acb7c..20b3657b5 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -524,8 +524,6 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, gdot_twin,dgdot_dtautwin,tau_twin real(pReal), dimension(3,3,3,3) :: & dLp_dMstar3333 !< derivative of Lp with respect to Mstar as 4th order tensor - real(pReal), dimension(3,3,2) :: & - nonSchmid_tensor type(tParameters) :: prm type(tPhenopowerlawState) :: stt @@ -548,19 +546,13 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, j = j+1_pInt ! Calculation of Lp - tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip) + tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos - 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) do k = 1,size(prm%nonSchmidCoeff) tau_slip_pos = tau_slip_pos & - + math_mul33xx33(Mstar,prm%nonSchmidCoeff(k)*lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph)) + + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) tau_slip_neg = tau_slip_neg & - + math_mul33xx33(Mstar,prm%nonSchmidCoeff(k)*lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + & - prm%nonSchmidCoeff(k)*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) + & - prm%nonSchmidCoeff(k)*lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) enddo gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) @@ -569,23 +561,23 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) Lp = Lp + (1.0_pReal-stt%sumF(of))*& - (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + (gdot_slip_pos+gdot_slip_neg)*prm%Schmid_slip(1:3,1:3,j) ! Calculation of the tangent of Lp if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) + & - dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,1) + dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) & + + dgdot_dtauslip_pos*prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) endif if (dNeq0(tau_slip_neg)) then dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) + & - dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,2) + dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) & + + dgdot_dtauslip_neg*prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) endif enddo slipSystems enddo slipFamilies From d51b00c2d377d775b14bc266b1e171782b2c4c03 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 20:06:19 +0200 Subject: [PATCH 07/41] no need to loop over families and systems independently. no need for 3333 --- src/plastic_phenopowerlaw.f90 | 79 ++++++++++++++++------------------- 1 file changed, 37 insertions(+), 42 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 20b3657b5..5057ceb95 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -523,7 +523,7 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, dgdot_dtauslip_pos,dgdot_dtauslip_neg, & gdot_twin,dgdot_dtautwin,tau_twin real(pReal), dimension(3,3,3,3) :: & - dLp_dMstar3333 !< derivative of Lp with respect to Mstar as 4th order tensor + dLp_dMstar !< derivative of Lp with respect to Mstar as 4th order tensor type(tParameters) :: prm type(tPhenopowerlawState) :: stt @@ -534,53 +534,48 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, stt => state(phase_plasticityInstance(ph))) Lp = 0.0_pReal - dLp_dMstar3333 = 0.0_pReal + dLp_dMstar = 0.0_pReal dLp_dMstar99 = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! Slip part - j = 0_pInt - slipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,prm%Nslip(f) - j = j+1_pInt + do j = 1_pInt, prm%totalNslip - ! Calculation of Lp - tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) - tau_slip_neg = tau_slip_pos - do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos & - + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg & - + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo - gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) + ! Calculation of Lp + tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_slip_neg = tau_slip_pos + do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos & + + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg & + + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo + gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & + ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) + gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & + ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) - Lp = Lp + (1.0_pReal-stt%sumF(of))*& - (gdot_slip_pos+gdot_slip_neg)*prm%Schmid_slip(1:3,1:3,j) + Lp = Lp + (1.0_pReal-stt%sumF(of))*& + (gdot_slip_pos+gdot_slip_neg)*prm%Schmid_slip(1:3,1:3,j) - ! Calculation of the tangent of Lp - if (dNeq0(tau_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) & - + dgdot_dtauslip_pos*prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) - endif + ! Calculation of the tangent of Lp + if (dNeq0(tau_slip_pos)) then + dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & + + dgdot_dtauslip_pos*prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) + endif + if (dNeq0(tau_slip_neg)) then + dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & + + dgdot_dtauslip_neg*prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) + endif - if (dNeq0(tau_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) & - + dgdot_dtauslip_neg*prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) - endif - enddo slipSystems - enddo slipFamilies + enddo !-------------------------------------------------------------------------------------------------- ! Twinning part @@ -601,14 +596,14 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, if (dNeq0(gdot_twin)) then dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar3333(k,l,m,n) = dLp_dMstar3333(k,l,m,n) + & - dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & + dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & + + dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & lattice_Stwin(m,n,index_myFamily+i,ph) endif enddo twinSystems enddo twinFamilies - dLp_dMstar99 = math_Plain3333to99(dLp_dMstar3333) + dLp_dMstar99 = math_Plain3333to99(dLp_dMstar) end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent From ba9330c8ddf668a7015daa131069e663416e7b84 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 20:08:46 +0200 Subject: [PATCH 08/41] early rename --- src/plastic_phenopowerlaw.f90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 5057ceb95..f6805b6b5 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -612,7 +612,7 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) +subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & @@ -626,7 +626,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) implicit none real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + Mstar6 !< Mandel stress integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point @@ -678,13 +678,13 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_pos = dot_product(Mstar6,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) tau_slip_pos = tau_slip_pos & - + dot_product(Tstar_v,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) + + dot_product(Mstar6,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg & - + dot_product(Tstar_v,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + + dot_product(Mstar6,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & @@ -700,7 +700,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac - tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + tau_twin = dot_product(Mstar6,lattice_Stwin_v(1:6,index_myFamily+i,ph)) gdot_twin(j) = (1.0_pReal-stt%sumF(of))*& ! 1-F prm%gdot0_twin*& (abs(tau_twin)/stt%s_twin(j,of))**& @@ -738,7 +738,7 @@ end subroutine plastic_phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) +function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) use material, only: & material_phase, & plasticState, & @@ -753,7 +753,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) implicit none real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + Mstar6 !< Mandel stress integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point @@ -798,13 +798,13 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_pos = dot_product(Mstar6,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos do k = 1,lattice_NnonSchmid(ph) tau_slip_pos = tau_slip_pos +prm%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + dot_product(Mstar6,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + dot_product(Mstar6,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & ((abs(tau_slip_pos)/stt%s_slip(j,of))**prm%n_slip & @@ -822,7 +822,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) slipSystems2: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & - dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + dot_product(Mstar6,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) enddo slipSystems2 enddo slipFamilies2 c = c + prm%totalNslip @@ -847,7 +847,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt - tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + tau = dot_product(Mstar6,lattice_Stwin_v(1:6,index_myFamily+i,ph)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F prm%gdot0_twin*& (abs(tau)/stt%s_twin(j,of))**& @@ -863,7 +863,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & - dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + dot_product(Mstar6,lattice_Stwin_v(1:6,index_myFamily+i,ph)) enddo twinSystems2 enddo twinFamilies2 c = c + prm%totalNtwin From 780699740d51a46482ae18ec26c1d172998ab25c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 20:19:02 +0200 Subject: [PATCH 09/41] internal (non)-Schmid definitions also in dotState --- src/plastic_phenopowerlaw.f90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f6805b6b5..c38b9733d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -619,6 +619,9 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) lattice_NslipSystem, & lattice_NtwinSystem, & lattice_shearTwin + use math, only: & + math_mul33xx33, & + math_Mandel6to33 use material, only: & material_phase, & phasememberAt, & @@ -642,6 +645,8 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin + real(pReal), dimension(3,3) :: & + Mstar real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & gdot_slip,left_SlipSlip,right_SlipSlip real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & @@ -657,6 +662,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dst => dotState(phase_plasticityInstance(ph))) dst%whole(:,of) = 0.0_pReal + Mstar = math_Mandel6to33(Mstar6) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -678,13 +684,11 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma - tau_slip_pos = dot_product(Mstar6,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos & - + dot_product(Mstar6,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg & - + dot_product(Mstar6,prm%nonSchmidCoeff(k)*lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) enddo nonSchmidSystems gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & From fbaac484ea6cf5936bfdbb6f56a21569c0f8890c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 20:32:01 +0200 Subject: [PATCH 10/41] extended to postResults --- src/plastic_phenopowerlaw.f90 | 38 +++++++++++++++++------------------ 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index c38b9733d..cb6cf0f79 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -120,8 +120,6 @@ subroutine plastic_phenopowerlaw_init debug_constitutive,& debug_levelBasic use math, only: & - math_Mandel3333to66, & - math_Voigt66to3333, & math_expand use IO, only: & IO_warning, & @@ -487,8 +485,7 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, dNeq0 use math, only: & math_mul33xx33,& - math_Plain3333to99, & - math_Mandel6to33 + math_Plain3333to99 use lattice, only: & lattice_Sslip, & lattice_Stwin, & @@ -748,6 +745,9 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) plasticState, & phasememberAt, & phase_plasticityInstance + use math, only: & + math_mul33xx33, & + math_Mandel6to33 use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & @@ -763,6 +763,8 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) ip, & !< integration point el !< element !< microstructure state + real(pReal), dimension(3,3) :: & + Mstar real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_phenopowerlaw_postResults @@ -782,6 +784,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) associate( prm => param(phase_plasticityInstance(ph)), & stt => state(phase_plasticityInstance(ph)), & dst => dotState(phase_plasticityInstance(ph))) + Mstar = math_Mandel6to33(Mstar6) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -798,23 +801,19 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (shearrate_slip_ID) j = 0_pInt - slipFamilies1: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipFamilies1: do f =1_pInt,size(prm%Nslip,1) + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems1: do i = 1_pInt,prm%Nslip(f) - j = j + 1_pInt - tau_slip_pos = dot_product(Mstar6,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + j = j+1_pInt + tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos - do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos +prm%nonSchmidCoeff(k)* & - dot_product(Mstar6,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & - dot_product(Mstar6,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - enddo + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo nonSchmidSystems plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/stt%s_slip(j,of))**prm%n_slip & - *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip & - *sign(1.0_pReal,tau_slip_neg)) + ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 c = c + prm%totalNslip @@ -825,8 +824,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems2: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt - plastic_phenopowerlaw_postResults(c+j) = & - dot_product(Mstar6,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) enddo slipSystems2 enddo slipFamilies2 c = c + prm%totalNslip From 3ff7c9c0eb78cb85e71fdf45833c45a9636635ba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 20:55:15 +0200 Subject: [PATCH 11/41] extendend to Schmid_twin --- src/plastic_phenopowerlaw.f90 | 141 ++++++++++++---------------------- 1 file changed, 47 insertions(+), 94 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index cb6cf0f79..3b1a57212 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -68,7 +68,8 @@ module plastic_phenopowerlaw interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity real(pReal), dimension(:,:,:), allocatable :: & - Schmid_slip + Schmid_slip, & + Schmid_twin real(pReal), dimension(:,:,:,:), allocatable :: & nonSchmid_pos, & nonSchmid_neg @@ -397,9 +398,13 @@ subroutine plastic_phenopowerlaw_init allocate(temp1(prm%totalNtwin,prm%totalNslip),source =0.0_pReal) allocate(temp2(prm%totalNtwin,prm%totalNtwin),source =0.0_pReal) + allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) + i = 0_pInt myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) myTwinSystems: do j = 1_pInt,prm%Ntwin(f) + i = i + 1_pInt + prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,index_myFamily+j,p) slipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) slipSystems: do k = 1_pInt,prm%Nslip(o) @@ -486,11 +491,6 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, use math, only: & math_mul33xx33,& math_Plain3333to99 - use lattice, only: & - lattice_Sslip, & - lattice_Stwin, & - lattice_NslipSystem, & - lattice_NtwinSystem use material, only: & phasememberAt, & material_phase, & @@ -538,7 +538,6 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, ! Slip part do j = 1_pInt, prm%totalNslip - ! Calculation of Lp tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos do k = 1,size(prm%nonSchmidCoeff) @@ -549,14 +548,12 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, enddo gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) Lp = Lp + (1.0_pReal-stt%sumF(of))*& (gdot_slip_pos+gdot_slip_neg)*prm%Schmid_slip(1:3,1:3,j) - ! Calculation of the tangent of Lp if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & @@ -576,29 +573,20 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, !-------------------------------------------------------------------------------------------------- ! Twinning part - j = 0_pInt - twinFamilies: do f = 1_pInt,size(prm%Ntwin,1) - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,prm%Ntwin(f) - j = j+1_pInt + do j = 1_pInt, prm%totalNtwin - ! Calculation of Lp - tau_twin = math_mul33xx33(Mstar,lattice_Stwin(1:3,1:3,index_myFamily+i,ph)) - gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*& - (abs(tau_twin)/stt%s_twin(j,of))**& - prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) - Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) + tau_twin = math_mul33xx33(Mstar,prm%Schmid_twin(1:3,1:3,j)) + gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin& + * max(0.0_pReal,sign(1.0_pReal,tau_twin)) + Lp = Lp + gdot_twin*prm%Schmid_twin(1:3,1:3,j) - ! Calculation of the tangent of Lp - if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & - + dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & - lattice_Stwin(m,n,index_myFamily+i,ph) - endif - enddo twinSystems - enddo twinFamilies + if (dNeq0(gdot_twin)) then + dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & + + dgdot_dtautwin*prm%Schmid_twin(k,l,j)*prm%Schmid_twin(m,n,j) + endif + enddo dLp_dMstar99 = math_Plain3333to99(dLp_dMstar) @@ -611,8 +599,6 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) use lattice, only: & - lattice_Sslip_v, & - lattice_Stwin_v, & lattice_NslipSystem, & lattice_NtwinSystem, & lattice_shearTwin @@ -668,7 +654,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) c_TwinTwin = prm%h0_TwinTwin * stt%sumF(of)**prm%twinD !-------------------------------------------------------------------------------------------------- -! calculate left and right vectors and calculate dot gammas +! calculate left and right vectors ssat_offset = prm%spr*sqrt(stt%sumF(of)) j = 0_pInt slipFamilies1: do f =1_pInt,size(prm%Nslip,1) @@ -679,8 +665,6 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) -!-------------------------------------------------------------------------------------------------- -! Calculation of dot gamma tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) @@ -693,21 +677,13 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) enddo slipSystems1 enddo slipFamilies1 - j = 0_pInt - twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,prm%Ntwin(f) - j = j+1_pInt - + do j = 1_pInt, prm%totalNtwin !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac - tau_twin = dot_product(Mstar6,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin(j) = (1.0_pReal-stt%sumF(of))*& ! 1-F - prm%gdot0_twin*& - (abs(tau_twin)/stt%s_twin(j,of))**& - prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) - enddo twinSystems1 - enddo twinFamilies1 + tau_twin = math_mul33xx33(Mstar,prm%Schmid_twin(1:3,1:3,j)) + gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* (abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin & + * max(0.0_pReal,sign(1.0_pReal,tau_twin)) + enddo !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above @@ -770,8 +746,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) integer(pInt) :: & ph, of, & - o,f,i,c,j,k, & - index_myFamily + o,f,i,c,j,k real(pReal) :: & tau_slip_pos,tau_slip_neg,tau @@ -800,33 +775,23 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) c = c + prm%totalNslip case (shearrate_slip_ID) - j = 0_pInt - slipFamilies1: do f =1_pInt,size(prm%Nslip,1) - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,prm%Nslip(f) - j = j+1_pInt - tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) - tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo nonSchmidSystems - plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & - ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) - enddo slipSystems1 - enddo slipFamilies1 + do j = 1_pInt, prm%totalNslip + tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_slip_neg = tau_slip_pos + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo nonSchmidSystems + plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & + ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) + enddo c = c + prm%totalNslip case (resolvedstress_slip_ID) - j = 0_pInt - slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,prm%Nslip(f) - j = j + 1_pInt - plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) - enddo slipSystems2 - enddo slipFamilies2 + do j = 1_pInt, prm%totalNslip + plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + enddo c = c + prm%totalNslip case (totalshear_ID) @@ -844,30 +809,18 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) c = c + prm%totalNtwin case (shearrate_twin_ID) - j = 0_pInt - twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,prm%Ntwin(f) - j = j + 1_pInt - tau = dot_product(Mstar6,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F - prm%gdot0_twin*& - (abs(tau)/stt%s_twin(j,of))**& + do j = 1_pInt, prm%totalNtwin + tau = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F + prm%gdot0_twin*(abs(tau)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) - enddo twinSystems1 - enddo twinFamilies1 + enddo c = c + prm%totalNtwin case (resolvedstress_twin_ID) - j = 0_pInt - twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,prm%Ntwin(f) - j = j + 1_pInt - plastic_phenopowerlaw_postResults(c+j) = & - dot_product(Mstar6,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - enddo twinSystems2 - enddo twinFamilies2 + do j = 1_pInt, prm%totalNtwin + plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + enddo c = c + prm%totalNtwin case (totalvolfrac_twin_ID) From f458de82faef56cd0e09d37d077ed48a34741f9d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 21:13:32 +0200 Subject: [PATCH 12/41] simplified --- src/plastic_phenopowerlaw.f90 | 68 +++++++++++++++-------------------- 1 file changed, 28 insertions(+), 40 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3b1a57212..6f5bdb112 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -291,6 +291,7 @@ subroutine plastic_phenopowerlaw_init ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') + prm%H_int = math_expand(prm%H_int,prm%Nslip) if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & extmsg = trim(extmsg)//"tau0_slip " @@ -511,9 +512,8 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, integer(pInt) :: & index_myFamily, & - f,i,j,k,l,m,n, & - of, & - ph + j,k,l,m,n, & + of real(pReal) :: & tau_slip_pos,tau_slip_neg, & gdot_slip_pos,gdot_slip_neg, & @@ -525,10 +525,9 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, type(tPhenopowerlawState) :: stt of = phasememberAt(ipc,ip,el) - ph = material_phase(ipc,ip,el) - associate(prm => param(phase_plasticityInstance(ph)),& - stt => state(phase_plasticityInstance(ph))) + associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& + stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) Lp = 0.0_pReal dLp_dMstar = 0.0_pReal @@ -599,7 +598,6 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) use lattice, only: & - lattice_NslipSystem, & lattice_NtwinSystem, & lattice_shearTwin use math, only: & @@ -639,10 +637,9 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) type(tPhenopowerlawState) :: dst,stt of = phasememberAt(ipc,ip,el) - ph = material_phase(ipc,ip,el) - associate(prm => param(phase_plasticityInstance(ph)), & - stt => state(phase_plasticityInstance(ph)), & - dst => dotState(phase_plasticityInstance(ph))) + associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & + stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))), & + dst => dotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) dst%whole(:,of) = 0.0_pReal Mstar = math_Mandel6to33(Mstar6) @@ -656,30 +653,23 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors ssat_offset = prm%spr*sqrt(stt%sumF(of)) - j = 0_pInt - slipFamilies1: do f =1_pInt,size(prm%Nslip,1) - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,prm%Nslip(f) - j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & - * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) + do j = 1_pInt, prm%totalNslip + left_SlipSlip(j) = 1.0_pReal + prm%H_int(j) ! modified no system-dependent left part + right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & + * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) - tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) - tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo nonSchmidSystems - gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & - ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) - enddo slipSystems1 - enddo slipFamilies1 + tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_slip_neg = tau_slip_pos + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo nonSchmidSystems + gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & + ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) + enddo do j = 1_pInt, prm%totalNtwin -!-------------------------------------------------------------------------------------------------- -! Calculation of dot vol frac tau_twin = math_mul33xx33(Mstar,prm%Schmid_twin(1:3,1:3,j)) gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* (abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin & * max(0.0_pReal,sign(1.0_pReal,tau_twin)) @@ -695,6 +685,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dst%sumGamma(of) = dst%sumGamma(of) + sum(abs(gdot_slip)) dst%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) + ph = material_phase(ipc,ip,el) j = 0_pInt twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -709,6 +700,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) enddo twinSystems2 enddo twinFamilies2 end associate + end subroutine plastic_phenopowerlaw_dotState @@ -746,19 +738,15 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) integer(pInt) :: & ph, of, & - o,f,i,c,j,k + o,c,j,k real(pReal) :: & tau_slip_pos,tau_slip_neg,tau type(tParameters) :: prm - type(tPhenopowerlawState) :: stt, dst + type(tPhenopowerlawState) :: stt - of = phasememberAt(ipc,ip,el) - ph = material_phase(ipc,ip,el) - - associate( prm => param(phase_plasticityInstance(ph)), & - stt => state(phase_plasticityInstance(ph)), & - dst => dotState(phase_plasticityInstance(ph))) + associate( prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & + stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))) ) Mstar = math_Mandel6to33(Mstar6) plastic_phenopowerlaw_postResults = 0.0_pReal From 4f1becb50388681301477b146b09bf7d86b7c9ab Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 21:27:14 +0200 Subject: [PATCH 13/41] cleaning and fixing bugs (wrong indices) --- src/plastic_phenopowerlaw.f90 | 59 +++++++++++++++++------------------ 1 file changed, 28 insertions(+), 31 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 6f5bdb112..6675d34d7 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -61,7 +61,8 @@ module plastic_phenopowerlaw tau0_twin, & !< initial critical shear stress for twin tausat_slip, & !< maximum critical shear stress for slip nonSchmidCoeff, & - H_int !< per family hardening activity (optional) + H_int, & !< per family hardening activity (optional) !ToDo: Better name! + shear_twin !< characteristic shear for twins real(pReal), dimension(:,:), allocatable :: & interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity @@ -159,7 +160,7 @@ subroutine plastic_phenopowerlaw_init type(tParameters) :: prm - integer(kind(undefined_ID)) :: & + integer(kind(undefined_ID)) :: & outputID !< ID of each post result output character(len=512) :: & @@ -291,7 +292,6 @@ subroutine plastic_phenopowerlaw_init ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') - prm%H_int = math_expand(prm%H_int,prm%Nslip) if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & extmsg = trim(extmsg)//"tau0_slip " @@ -301,6 +301,9 @@ subroutine plastic_phenopowerlaw_init if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + + prm%H_int = math_expand(prm%H_int,prm%Nslip) + prm%tausat_slip = math_expand(prm%tausat_slip,prm%Nslip) endif if (prm%totalNtwin > 0_pInt) then @@ -397,15 +400,17 @@ subroutine plastic_phenopowerlaw_init prm%interaction_SlipTwin = temp2; deallocate(temp2) - allocate(temp1(prm%totalNtwin,prm%totalNslip),source =0.0_pReal) - allocate(temp2(prm%totalNtwin,prm%totalNtwin),source =0.0_pReal) - allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) + allocate(temp1(prm%totalNtwin,prm%totalNslip),source = 0.0_pReal) + allocate(temp2(prm%totalNtwin,prm%totalNtwin),source = 0.0_pReal) + allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) + allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal) i = 0_pInt myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) myTwinSystems: do j = 1_pInt,prm%Ntwin(f) i = i + 1_pInt prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,index_myFamily+j,p) + prm%shear_twin(i) = lattice_shearTwin(index_myFamily+j,p) slipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) slipSystems: do k = 1_pInt,prm%Nslip(o) @@ -597,9 +602,6 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) - use lattice, only: & - lattice_NtwinSystem, & - lattice_shearTwin use math, only: & math_mul33xx33, & math_Mandel6to33 @@ -618,7 +620,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) integer(pInt) :: & ph, & - f,i,j,k, & + j,k, & index_myFamily, & of real(pReal) :: & @@ -655,8 +657,8 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) ssat_offset = prm%spr*sqrt(stt%sumF(of)) do j = 1_pInt, prm%totalNslip left_SlipSlip(j) = 1.0_pReal + prm%H_int(j) ! modified no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & - * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) + right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) **prm%a_slip & + * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos @@ -677,7 +679,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above - do j = 1_pInt,prm%totalNslip + do j = 1_pInt, prm%totalNslip dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor @@ -685,20 +687,14 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dst%sumGamma(of) = dst%sumGamma(of) + sum(abs(gdot_slip)) dst%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) - ph = material_phase(ipc,ip,el) - j = 0_pInt - twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,prm%Ntwin(f) - j = j+1_pInt - dst%s_twin(j,of) = & ! evolution of twin resistance j - c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor - if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - dst%accshear_twin(j,of) = abs(gdot_twin(j)) - enddo twinSystems2 - enddo twinFamilies2 + do j = 1_pInt, prm%totalNtwin + dst%s_twin(j,of) = & ! evolution of twin resistance j + c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor + if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/prm%shear_twin(j) + dst%accshear_twin(j,of) = abs(gdot_twin(j)) + enddo end associate end subroutine plastic_phenopowerlaw_dotState @@ -740,7 +736,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) ph, of, & o,c,j,k real(pReal) :: & - tau_slip_pos,tau_slip_neg,tau + tau_slip_pos,tau_slip_neg,tau_twin type(tParameters) :: prm type(tPhenopowerlawState) :: stt @@ -798,10 +794,10 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (shearrate_twin_ID) do j = 1_pInt, prm%totalNtwin - tau = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_twin = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F - prm%gdot0_twin*(abs(tau)/stt%s_twin(j,of))**& - prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) + prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**& + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo c = c + prm%totalNtwin @@ -818,6 +814,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) end select enddo outputsLoop end associate + end function plastic_phenopowerlaw_postResults end module plastic_phenopowerlaw From 83740b5d7bc4a9fdf34b02266e40dc0727a3271c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 21:39:18 +0200 Subject: [PATCH 14/41] accidently commited .. --- examples/SpectralMethod/Polycrystal/material.config | 1 - 1 file changed, 1 deletion(-) diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 572b87ef4..1819119fe 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -55,7 +55,6 @@ a_slip 2.25 h0_slipslip 75e6 interaction_slipslip 1 1 1.4 1.4 1.4 1.4 atol_resistance 1 -nonschmid_coefficients 0.938 0.71 4.43 0.0 0.0 0.0 #-------------------# From 0041d21777cfdf873bb30e880bfaae7cb0a255b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Aug 2018 06:20:48 +0200 Subject: [PATCH 15/41] output was screwed up --- src/plastic_phenopowerlaw.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 6675d34d7..188b0f6cd 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -666,14 +666,14 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) enddo nonSchmidSystems - gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & + gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & !ToDo: save to dotState ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) enddo do j = 1_pInt, prm%totalNtwin tau_twin = math_mul33xx33(Mstar,prm%Schmid_twin(1:3,1:3,j)) - gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* (abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin & + gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* (abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin & !ToDo: save to dotState * max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo @@ -733,7 +733,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) plastic_phenopowerlaw_postResults integer(pInt) :: & - ph, of, & + of, & o,c,j,k real(pReal) :: & tau_slip_pos,tau_slip_neg,tau_twin @@ -741,6 +741,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) type(tParameters) :: prm type(tPhenopowerlawState) :: stt + of = phasememberAt(ipc,ip,el) associate( prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))) ) Mstar = math_Mandel6to33(Mstar6) From baeb449e07932fd01abb32eb46c74542624dbbff Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 29 Aug 2018 08:18:32 +0200 Subject: [PATCH 16/41] WIP: debugging --- src/constitutive.f90 | 2 +- src/plastic_phenopowerlaw.f90 | 121 ++++++++++++++++++---------------- 2 files changed, 64 insertions(+), 59 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 1db467974..98dfe91ef 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -503,7 +503,7 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v case (PLASTICITY_ISOTROPIC_ID) plasticityType call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMstar,Mstar,ipc,ip,el) + call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_KINEHARDENING_ID) plasticityType call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 188b0f6cd..8f6a3c5ae 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -68,6 +68,9 @@ module plastic_phenopowerlaw interaction_SlipTwin, & !< slip resistance from twin activity interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity + real(pReal), dimension(:,:), allocatable :: & + Schmid_slip6, & + Schmid_twin6 real(pReal), dimension(:,:,:), allocatable :: & Schmid_slip, & Schmid_twin @@ -360,21 +363,25 @@ subroutine plastic_phenopowerlaw_init allocate(temp1(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) allocate(temp2(prm%totalNslip,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_slip(3,3,prm%totalNslip),source = 0.0_pReal) - allocate(prm%nonSchmid_pos(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) - allocate(prm%nonSchmid_neg(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) + allocate(prm%Schmid_slip6(6,prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_pos(3,3,size(prm%nonSchmidCoeff)+1,prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_neg(3,3,size(prm%nonSchmidCoeff)+1,prm%totalNslip),source = 0.0_pReal) i = 0_pInt mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X index_myFamily = sum(prm%Nslip(1:f-1_pInt)) mySlipSystems: do j = 1_pInt,prm%Nslip(f) i = i + 1_pInt - prm%Schmid_slip(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,index_myFamily+j,p) - do k = 1,size(prm%nonSchmidCoeff) - prm%nonSchmid_pos(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) & - * prm%nonSchmidCoeff(k) - prm%nonSchmid_neg(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) & - * prm%nonSchmidCoeff(k) - enddo + prm%Schmid_slip(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) + prm%Schmid_slip6(1:6,i) = lattice_Sslip_v(1:6,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) + !prm%nonSchmid_pos(1:3,1:3,1,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) + !prm%nonSchmid_neg(1:3,1:3,1,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) + !do k = 1,size(prm%nonSchmidCoeff) + ! prm%nonSchmid_pos(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) & + ! * prm%nonSchmidCoeff(k) + ! prm%nonSchmid_neg(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) & + ! * prm%nonSchmidCoeff(k) + !enddo 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) @@ -403,14 +410,16 @@ subroutine plastic_phenopowerlaw_init allocate(temp1(prm%totalNtwin,prm%totalNslip),source = 0.0_pReal) allocate(temp2(prm%totalNtwin,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) + allocate(prm%Schmid_twin6(6,prm%totalNtwin),source = 0.0_pReal) allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal) i = 0_pInt myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) myTwinSystems: do j = 1_pInt,prm%Ntwin(f) i = i + 1_pInt - prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,index_myFamily+j,p) - prm%shear_twin(i) = lattice_shearTwin(index_myFamily+j,p) + prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,sum(lattice_NTwinsystem(1:f-1,p))+j,p) + prm%Schmid_twin6(1:6,i) = lattice_Stwin_v(1:6,sum(lattice_Ntwinsystem(1:f-1,p))+j,p) + prm%shear_twin(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p) slipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) slipSystems: do k = 1_pInt,prm%Nslip(o) @@ -491,11 +500,12 @@ end subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc,ip,el) +subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip,el) use prec, only: & dNeq0 use math, only: & math_mul33xx33,& + math_Mandel33to6, & math_Plain3333to99 use material, only: & phasememberAt, & @@ -512,8 +522,8 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), dimension(3,3), intent(in) :: & - Mstar !< Mandel stress + real(pReal), dimension(6), intent(in) :: & + Mstar_v !< Mandel stress integer(pInt) :: & index_myFamily, & @@ -536,41 +546,37 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, Lp = 0.0_pReal dLp_dMstar = 0.0_pReal - dLp_dMstar99 = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! Slip part do j = 1_pInt, prm%totalNslip - tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_slip_pos = dot_product(Mstar_v,prm%Schmid_slip6(1:6,j)) tau_slip_neg = tau_slip_pos - do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos & - + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg & - + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo - gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) + !do k = 1,size(prm%nonSchmidCoeff) + ! tau_slip_pos = tau_slip_pos & + ! + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + ! tau_slip_neg = tau_slip_neg & + ! + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) + !enddo + gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & + * sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) + gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & + * sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg) - Lp = Lp + (1.0_pReal-stt%sumF(of))*& - (gdot_slip_pos+gdot_slip_neg)*prm%Schmid_slip(1:3,1:3,j) + Lp = Lp + (1.0_pReal-stt%sumF(of))*(gdot_slip_pos+gdot_slip_neg)*prm%Schmid_slip(1:3,1:3,j) if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & - + dgdot_dtauslip_pos*prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) + + dgdot_dtauslip_pos*prm%Schmid_slip(k,l,j)*prm%Schmid_slip(m,n,j)!sum(prm%nonSchmid_pos(m,n,:,j),3) endif if (dNeq0(tau_slip_neg)) then dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & - + dgdot_dtauslip_neg*prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) + + dgdot_dtauslip_neg*prm%Schmid_slip(k,l,j)*prm%Schmid_slip(m,n,j)!sum(prm%nonSchmid_neg(m,n,:,j),3) endif enddo @@ -579,7 +585,7 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar,ipc, ! Twinning part do j = 1_pInt, prm%totalNtwin - tau_twin = math_mul33xx33(Mstar,prm%Schmid_twin(1:3,1:3,j)) + tau_twin = dot_product(Mstar_v,prm%Schmid_twin6(1:6,j)) gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin& * max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*prm%Schmid_twin(1:3,1:3,j) @@ -628,8 +634,8 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(3,3) :: & - Mstar + !real(pReal), dimension(3,3) :: & + ! Mstar real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & gdot_slip,left_SlipSlip,right_SlipSlip real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & @@ -644,7 +650,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dst => dotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) dst%whole(:,of) = 0.0_pReal - Mstar = math_Mandel6to33(Mstar6) + !Mstar = math_Mandel6to33(Mstar6) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -660,20 +666,20 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) **prm%a_slip & * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) - tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_slip_pos = dot_product(Mstar6,prm%Schmid_slip6(1:6,j)) tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo nonSchmidSystems + !nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + ! tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + ! tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) + !enddo nonSchmidSystems gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & !ToDo: save to dotState - ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) + ( sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) & + + sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg)) enddo do j = 1_pInt, prm%totalNtwin - tau_twin = math_mul33xx33(Mstar,prm%Schmid_twin(1:3,1:3,j)) - gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* (abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin & !ToDo: save to dotState + tau_twin = dot_product(Mstar6,prm%Schmid_twin6(1:6,j)) + gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* abs(tau_twin/stt%s_twin(j,of))**prm%n_twin & !ToDo: save to dotState * max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo @@ -727,8 +733,8 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) ip, & !< integration point el !< element !< microstructure state - real(pReal), dimension(3,3) :: & - Mstar + !real(pReal), dimension(3,3) :: & + ! Mstar real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_phenopowerlaw_postResults @@ -744,7 +750,6 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) of = phasememberAt(ipc,ip,el) associate( prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))) ) - Mstar = math_Mandel6to33(Mstar6) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -761,21 +766,21 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (shearrate_slip_ID) do j = 1_pInt, prm%totalNslip - tau_slip_pos = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_slip_pos = dot_product(Mstar6,prm%Schmid_slip6(1:6,j)) tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo nonSchmidSystems + !nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + ! tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) + ! tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) + !enddo nonSchmidSystems plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & - ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) + ( sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) & + +sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg)) enddo c = c + prm%totalNslip case (resolvedstress_slip_ID) do j = 1_pInt, prm%totalNslip - plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + plastic_phenopowerlaw_postResults(c+j) = dot_product(Mstar6,prm%Schmid_slip6(1:6,j)) enddo c = c + prm%totalNslip @@ -795,7 +800,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (shearrate_twin_ID) do j = 1_pInt, prm%totalNtwin - tau_twin = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + tau_twin = dot_product(Mstar6,prm%Schmid_twin6(1:6,j)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) @@ -804,7 +809,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (resolvedstress_twin_ID) do j = 1_pInt, prm%totalNtwin - plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(Mstar,prm%Schmid_slip(1:3,1:3,j)) + plastic_phenopowerlaw_postResults(c+j) = dot_product(Mstar6,prm%Schmid_twin6(1:6,j)) enddo c = c + prm%totalNtwin From 922273f230cbeab824e7b8c1fca43409860aeb59 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 29 Aug 2018 12:03:31 +0200 Subject: [PATCH 17/41] does not make sense to store and use the 6-vector version of the Schmid matrix --- src/plastic_phenopowerlaw.f90 | 39 ++++++++++++++++------------------- 1 file changed, 18 insertions(+), 21 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 8f6a3c5ae..6b8e9d1e2 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -68,9 +68,6 @@ module plastic_phenopowerlaw interaction_SlipTwin, & !< slip resistance from twin activity interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity - real(pReal), dimension(:,:), allocatable :: & - Schmid_slip6, & - Schmid_twin6 real(pReal), dimension(:,:,:), allocatable :: & Schmid_slip, & Schmid_twin @@ -363,7 +360,6 @@ subroutine plastic_phenopowerlaw_init allocate(temp1(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) allocate(temp2(prm%totalNslip,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_slip(3,3,prm%totalNslip),source = 0.0_pReal) - allocate(prm%Schmid_slip6(6,prm%totalNslip),source = 0.0_pReal) allocate(prm%nonSchmid_pos(3,3,size(prm%nonSchmidCoeff)+1,prm%totalNslip),source = 0.0_pReal) allocate(prm%nonSchmid_neg(3,3,size(prm%nonSchmidCoeff)+1,prm%totalNslip),source = 0.0_pReal) i = 0_pInt @@ -373,7 +369,6 @@ subroutine plastic_phenopowerlaw_init mySlipSystems: do j = 1_pInt,prm%Nslip(f) i = i + 1_pInt prm%Schmid_slip(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) - prm%Schmid_slip6(1:6,i) = lattice_Sslip_v(1:6,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) !prm%nonSchmid_pos(1:3,1:3,1,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) !prm%nonSchmid_neg(1:3,1:3,1,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) !do k = 1,size(prm%nonSchmidCoeff) @@ -410,7 +405,6 @@ subroutine plastic_phenopowerlaw_init allocate(temp1(prm%totalNtwin,prm%totalNslip),source = 0.0_pReal) allocate(temp2(prm%totalNtwin,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) - allocate(prm%Schmid_twin6(6,prm%totalNtwin),source = 0.0_pReal) allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal) i = 0_pInt myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X @@ -418,7 +412,6 @@ subroutine plastic_phenopowerlaw_init myTwinSystems: do j = 1_pInt,prm%Ntwin(f) i = i + 1_pInt prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,sum(lattice_NTwinsystem(1:f-1,p))+j,p) - prm%Schmid_twin6(1:6,i) = lattice_Stwin_v(1:6,sum(lattice_Ntwinsystem(1:f-1,p))+j,p) prm%shear_twin(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p) slipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) @@ -505,7 +498,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, dNeq0 use math, only: & math_mul33xx33,& - math_Mandel33to6, & + math_Mandel6to33, & math_Plain3333to99 use material, only: & phasememberAt, & @@ -534,6 +527,8 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, gdot_slip_pos,gdot_slip_neg, & dgdot_dtauslip_pos,dgdot_dtauslip_neg, & gdot_twin,dgdot_dtautwin,tau_twin + real(pReal), dimension(3,3) :: & + S !< Second-Piola Kirchhoff stress real(pReal), dimension(3,3,3,3) :: & dLp_dMstar !< derivative of Lp with respect to Mstar as 4th order tensor type(tParameters) :: prm @@ -547,11 +542,12 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, Lp = 0.0_pReal dLp_dMstar = 0.0_pReal + S = math_Mandel6to33(Mstar_v) !-------------------------------------------------------------------------------------------------- ! Slip part do j = 1_pInt, prm%totalNslip - tau_slip_pos = dot_product(Mstar_v,prm%Schmid_slip6(1:6,j)) + tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos !do k = 1,size(prm%nonSchmidCoeff) ! tau_slip_pos = tau_slip_pos & @@ -585,7 +581,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, ! Twinning part do j = 1_pInt, prm%totalNtwin - tau_twin = dot_product(Mstar_v,prm%Schmid_twin6(1:6,j)) + tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin& * max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*prm%Schmid_twin(1:3,1:3,j) @@ -634,8 +630,8 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - !real(pReal), dimension(3,3) :: & - ! Mstar + real(pReal), dimension(3,3) :: & + S !< Second-Piola Kirchhoff stress real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & gdot_slip,left_SlipSlip,right_SlipSlip real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & @@ -650,7 +646,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dst => dotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) dst%whole(:,of) = 0.0_pReal - !Mstar = math_Mandel6to33(Mstar6) + S = math_Mandel6to33(Mstar6) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -666,7 +662,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) **prm%a_slip & * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) - tau_slip_pos = dot_product(Mstar6,prm%Schmid_slip6(1:6,j)) + tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos !nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) ! tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) @@ -678,7 +674,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) enddo do j = 1_pInt, prm%totalNtwin - tau_twin = dot_product(Mstar6,prm%Schmid_twin6(1:6,j)) + tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* abs(tau_twin/stt%s_twin(j,of))**prm%n_twin & !ToDo: save to dotState * max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo @@ -733,8 +729,8 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) ip, & !< integration point el !< element !< microstructure state - !real(pReal), dimension(3,3) :: & - ! Mstar + real(pReal), dimension(3,3) :: & + S !< Second-Piola Kirchhoff stress real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_phenopowerlaw_postResults @@ -753,6 +749,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt + S = math_Mandel6to33(Mstar6) outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) @@ -766,7 +763,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (shearrate_slip_ID) do j = 1_pInt, prm%totalNslip - tau_slip_pos = dot_product(Mstar6,prm%Schmid_slip6(1:6,j)) + tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos !nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) ! tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) @@ -780,7 +777,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (resolvedstress_slip_ID) do j = 1_pInt, prm%totalNslip - plastic_phenopowerlaw_postResults(c+j) = dot_product(Mstar6,prm%Schmid_slip6(1:6,j)) + plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) enddo c = c + prm%totalNslip @@ -800,7 +797,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (shearrate_twin_ID) do j = 1_pInt, prm%totalNtwin - tau_twin = dot_product(Mstar6,prm%Schmid_twin6(1:6,j)) + tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) @@ -809,7 +806,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (resolvedstress_twin_ID) do j = 1_pInt, prm%totalNtwin - plastic_phenopowerlaw_postResults(c+j) = dot_product(Mstar6,prm%Schmid_twin6(1:6,j)) + plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) enddo c = c + prm%totalNtwin From 6d28883db5abefe5b4cf38f5724264faaa864e86 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 29 Aug 2018 12:07:51 +0200 Subject: [PATCH 18/41] starting to include non-Schmid terms (again) --- src/plastic_phenopowerlaw.f90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 6b8e9d1e2..88ff6c4da 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -360,8 +360,8 @@ subroutine plastic_phenopowerlaw_init allocate(temp1(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) allocate(temp2(prm%totalNslip,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_slip(3,3,prm%totalNslip),source = 0.0_pReal) - allocate(prm%nonSchmid_pos(3,3,size(prm%nonSchmidCoeff)+1,prm%totalNslip),source = 0.0_pReal) - allocate(prm%nonSchmid_neg(3,3,size(prm%nonSchmidCoeff)+1,prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_pos(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) + allocate(prm%nonSchmid_neg(3,3,size(prm%nonSchmidCoeff),prm%totalNslip),source = 0.0_pReal) i = 0_pInt mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X index_myFamily = sum(prm%Nslip(1:f-1_pInt)) @@ -369,14 +369,12 @@ subroutine plastic_phenopowerlaw_init mySlipSystems: do j = 1_pInt,prm%Nslip(f) i = i + 1_pInt prm%Schmid_slip(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) - !prm%nonSchmid_pos(1:3,1:3,1,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) - !prm%nonSchmid_neg(1:3,1:3,1,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) - !do k = 1,size(prm%nonSchmidCoeff) - ! prm%nonSchmid_pos(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) & - ! * prm%nonSchmidCoeff(k) - ! prm%nonSchmid_neg(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) & - ! * prm%nonSchmidCoeff(k) - !enddo + do k = 1,size(prm%nonSchmidCoeff) + prm%nonSchmid_pos(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) & + * prm%nonSchmidCoeff(k) + prm%nonSchmid_neg(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) & + * prm%nonSchmidCoeff(k) + enddo 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) From b163a8aaa0d240a4a36e0b40e3af39945cf41a3f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Aug 2018 00:57:15 +0200 Subject: [PATCH 19/41] Non-schmid activated again internally, no need for long name plastic_phenopowerlaw_postResults --- src/plastic_phenopowerlaw.f90 | 70 +++++++++++++++++------------------ 1 file changed, 33 insertions(+), 37 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 88ff6c4da..03c114eb2 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -370,9 +370,9 @@ subroutine plastic_phenopowerlaw_init i = i + 1_pInt prm%Schmid_slip(1:3,1:3,i) = lattice_Sslip(1:3,1:3,1,sum(lattice_Nslipsystem(1:f-1,p))+j,p) do k = 1,size(prm%nonSchmidCoeff) - prm%nonSchmid_pos(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) & + prm%nonSchmid_pos(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k, index_myFamily+j,p) & * prm%nonSchmidCoeff(k) - prm%nonSchmid_neg(1:3,1:3,k+1,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) & + prm%nonSchmid_neg(1:3,1:3,k,i) = lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+j,p) & * prm%nonSchmidCoeff(k) enddo otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) @@ -547,12 +547,10 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos - !do k = 1,size(prm%nonSchmidCoeff) - ! tau_slip_pos = tau_slip_pos & - ! + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - ! tau_slip_neg = tau_slip_neg & - ! + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - !enddo + do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & * sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & @@ -563,14 +561,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & - + dgdot_dtauslip_pos*prm%Schmid_slip(k,l,j)*prm%Schmid_slip(m,n,j)!sum(prm%nonSchmid_pos(m,n,:,j),3) + dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) + dgdot_dtauslip_pos & + * prm%Schmid_slip(k,l,j)*(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) endif if (dNeq0(tau_slip_neg)) then dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & - + dgdot_dtauslip_neg*prm%Schmid_slip(k,l,j)*prm%Schmid_slip(m,n,j)!sum(prm%nonSchmid_neg(m,n,:,j),3) + dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) + dgdot_dtauslip_neg & + * prm%Schmid_slip(k,l,j)*(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) endif enddo @@ -662,10 +660,10 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos - !nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - ! tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - ! tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - !enddo nonSchmidSystems + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo nonSchmidSystems gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & !ToDo: save to dotState ( sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) & + sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg)) @@ -703,7 +701,7 @@ end subroutine plastic_phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) +function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) use material, only: & material_phase, & plasticState, & @@ -730,7 +728,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & - plastic_phenopowerlaw_postResults + postResults integer(pInt) :: & of, & @@ -745,29 +743,29 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) associate( prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))) ) - plastic_phenopowerlaw_postResults = 0.0_pReal + postResults = 0.0_pReal c = 0_pInt S = math_Mandel6to33(Mstar6) outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%s_slip(1:prm%totalNslip,of) + postResults(c+1_pInt:c+prm%totalNslip) = stt%s_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) + postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (shearrate_slip_ID) do j = 1_pInt, prm%totalNslip tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos - !nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - ! tau_slip_pos = tau_slip_pos + math_mul33xx33(Mstar,prm%nonSchmid_pos(1:3,1:3,k,j)) - ! tau_slip_neg = tau_slip_neg + math_mul33xx33(Mstar,prm%nonSchmid_neg(1:3,1:3,k,j)) - !enddo nonSchmidSystems - plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo nonSchmidSystems + postResults(c+j) = prm%gdot0_slip*0.5_pReal* & ( sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) & +sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg)) enddo @@ -775,41 +773,39 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) case (resolvedstress_slip_ID) do j = 1_pInt, prm%totalNslip - plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) + postResults(c+j) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) enddo c = c + prm%totalNslip case (totalshear_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumGamma(of) + postResults(c+1_pInt) = stt%sumGamma(of) c = c + 1_pInt case (resistance_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - stt%s_twin(1:prm%totalNtwin,of) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%s_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (accumulatedshear_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - stt%accshear_twin(1:prm%totalNtwin,of) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (shearrate_twin_ID) do j = 1_pInt, prm%totalNtwin tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) - plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F - prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**& - prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + postResults(c+j) = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin * & + (abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin, & + 0.0_pReal, tau_twin>0.0_pReal) enddo c = c + prm%totalNtwin case (resolvedstress_twin_ID) do j = 1_pInt, prm%totalNtwin - plastic_phenopowerlaw_postResults(c+j) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) + postResults(c+j) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) enddo c = c + prm%totalNtwin case (totalvolfrac_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumF(of) + postResults(c+1_pInt) = stt%sumF(of) c = c + 1_pInt end select From cf65aae92afff7419e1f54a34671ead8f2252d6d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 17:17:45 +0200 Subject: [PATCH 20/41] correct names --- src/plastic_phenopowerlaw.f90 | 51 +++++++++++++++-------------------- 1 file changed, 22 insertions(+), 29 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 03c114eb2..ec074cb21 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -514,7 +514,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, ip, & !< integration point el !< element real(pReal), dimension(6), intent(in) :: & - Mstar_v !< Mandel stress + Mstar_v !< Mandel stress integer(pInt) :: & index_myFamily, & @@ -528,7 +528,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(3,3,3,3) :: & - dLp_dMstar !< derivative of Lp with respect to Mstar as 4th order tensor + dLp_dS !< derivative of Lp with respect to Mstar as 4th order tensor type(tParameters) :: prm type(tPhenopowerlawState) :: stt @@ -538,12 +538,11 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) Lp = 0.0_pReal - dLp_dMstar = 0.0_pReal + dLp_dS = 0.0_pReal S = math_Mandel6to33(Mstar_v) -!-------------------------------------------------------------------------------------------------- -! Slip part - do j = 1_pInt, prm%totalNslip + + slipSystems: do j = 1_pInt, prm%totalNslip tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip_neg = tau_slip_pos @@ -561,36 +560,36 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) + dgdot_dtauslip_pos & - * prm%Schmid_slip(k,l,j)*(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) + dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + + dgdot_dtauslip_pos * prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) endif if (dNeq0(tau_slip_neg)) then dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) + dgdot_dtauslip_neg & - * prm%Schmid_slip(k,l,j)*(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) + dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + + dgdot_dtauslip_neg * prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) endif - enddo + enddo slipSystems -!-------------------------------------------------------------------------------------------------- -! Twinning part - do j = 1_pInt, prm%totalNtwin + twinSystems: do j = 1_pInt, prm%totalNtwin tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) - gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin& + gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin & * max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*prm%Schmid_twin(1:3,1:3,j) if (dNeq0(gdot_twin)) then dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMstar(k,l,m,n) = dLp_dMstar(k,l,m,n) & - + dgdot_dtautwin*prm%Schmid_twin(k,l,j)*prm%Schmid_twin(m,n,j) + dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + + dgdot_dtautwin*prm%Schmid_twin(k,l,j)*prm%Schmid_twin(m,n,j) endif - enddo + enddo twinSystems - dLp_dMstar99 = math_Plain3333to99(dLp_dMstar) + dLp_dMstar99 = math_Plain3333to99(dLp_dS) end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent @@ -653,7 +652,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors ssat_offset = prm%spr*sqrt(stt%sumF(of)) - do j = 1_pInt, prm%totalNslip + slipSystems: do j = 1_pInt, prm%totalNslip left_SlipSlip(j) = 1.0_pReal + prm%H_int(j) ! modified no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) **prm%a_slip & * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) @@ -667,13 +666,13 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & !ToDo: save to dotState ( sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) & + sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg)) - enddo + enddo slipSystems - do j = 1_pInt, prm%totalNtwin + twinSystems: do j = 1_pInt, prm%totalNtwin tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* abs(tau_twin/stt%s_twin(j,of))**prm%n_twin & !ToDo: save to dotState * max(0.0_pReal,sign(1.0_pReal,tau_twin)) - enddo + enddo twinSystems !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above @@ -710,12 +709,6 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) use math, only: & math_mul33xx33, & math_Mandel6to33 - use lattice, only: & - lattice_Sslip_v, & - lattice_Stwin_v, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid implicit none real(pReal), dimension(6), intent(in) :: & From c9208315f59c81840a1e5bf9f580a81e31e8622b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 09:23:11 +0200 Subject: [PATCH 21/41] avoid repeated calculations does not save so much here, but avoids having inconsistent calculation (e.g. nonSchmid effects) and serves as a template for more complex models --- src/plastic_phenopowerlaw.f90 | 235 +++++++++++++++++++++++----------- 1 file changed, 158 insertions(+), 77 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index ec074cb21..3a4195773 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -521,14 +521,18 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, j,k,l,m,n, & of real(pReal) :: & - tau_slip_pos,tau_slip_neg, & - gdot_slip_pos,gdot_slip_neg, & dgdot_dtauslip_pos,dgdot_dtauslip_neg, & - gdot_twin,dgdot_dtautwin,tau_twin + dgdot_dtautwin real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(3,3,3,3) :: & dLp_dS !< derivative of Lp with respect to Mstar as 4th order tensor + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + tau_slip_pos,tau_slip_neg, & + gdot_slip_pos,gdot_slip_neg + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & + gdot_twin,tau_twin + type(tParameters) :: prm type(tPhenopowerlawState) :: stt @@ -542,47 +546,33 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, S = math_Mandel6to33(Mstar_v) + call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) + call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) slipSystems: do j = 1_pInt, prm%totalNslip - - tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) - tau_slip_neg = tau_slip_pos - do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo - gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & - * sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) - gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & - * sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg) - - Lp = Lp + (1.0_pReal-stt%sumF(of))*(gdot_slip_pos+gdot_slip_neg)*prm%Schmid_slip(1:3,1:3,j) - - if (dNeq0(tau_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos + Lp = Lp + (1.0_pReal-stt%sumF(of))*(gdot_slip_pos(j)+gdot_slip_neg(j))*prm%Schmid_slip(1:3,1:3,j) + if (dNeq0(tau_slip_pos(j))) then + dgdot_dtauslip_pos = gdot_slip_pos(j)*prm%n_slip/tau_slip_pos(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + dgdot_dtauslip_pos * prm%Schmid_slip(k,l,j) & *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) endif - if (dNeq0(tau_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg + if (dNeq0(tau_slip_neg(j))) then + dgdot_dtauslip_neg = gdot_slip_neg(j)*prm%n_slip/tau_slip_neg(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + dgdot_dtauslip_neg * prm%Schmid_slip(k,l,j) & *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) endif - enddo slipSystems + call resolvedStress_twin(prm,S,tau_twin) + call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) twinSystems: do j = 1_pInt, prm%totalNtwin + Lp = Lp + gdot_twin(j)*prm%Schmid_twin(1:3,1:3,j) - tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) - gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin & - * max(0.0_pReal,sign(1.0_pReal,tau_twin)) - Lp = Lp + gdot_twin*prm%Schmid_twin(1:3,1:3,j) - - if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin + if (dNeq0(gdot_twin(j))) then + dgdot_dtautwin = gdot_twin(j)*prm%n_twin/tau_twin(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + dgdot_dtautwin*prm%Schmid_twin(k,l,j)*prm%Schmid_twin(m,n,j) @@ -622,15 +612,17 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & - ssat_offset, & - tau_slip_pos,tau_slip_neg,tau_twin + ssat_offset real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & gdot_slip,left_SlipSlip,right_SlipSlip + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + tau_slip_pos,tau_slip_neg, & + gdot_slip_pos,gdot_slip_neg real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & - gdot_twin + gdot_twin,tau_twin type(tParameters) :: prm type(tPhenopowerlawState) :: dst,stt @@ -643,6 +635,14 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dst%whole(:,of) = 0.0_pReal S = math_Mandel6to33(Mstar6) +!-------------------------------------------------------------------------------------------------- +! shear rates + call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) + call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) + gdot_slip = 0.5_pReal*(gdot_slip_pos+gdot_slip_neg) + call resolvedStress_twin(prm,S,tau_twin) + call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) + !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices c_SlipSlip = prm%h0_slipslip * (1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) @@ -657,46 +657,137 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) **prm%a_slip & * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) - tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) - tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo nonSchmidSystems - gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & !ToDo: save to dotState - ( sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) & - + sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg)) enddo slipSystems - twinSystems: do j = 1_pInt, prm%totalNtwin - tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) - gdot_twin(j) = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin* abs(tau_twin/stt%s_twin(j,of))**prm%n_twin & !ToDo: save to dotState - * max(0.0_pReal,sign(1.0_pReal,tau_twin)) - enddo twinSystems - !-------------------------------------------------------------------------------------------------- -! calculate the overall hardening based on above - do j = 1_pInt, prm%totalNslip +! hardening + hardeningSlip: do j = 1_pInt, prm%totalNslip dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor - enddo + enddo hardeningSlip dst%sumGamma(of) = dst%sumGamma(of) + sum(abs(gdot_slip)) dst%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) - do j = 1_pInt, prm%totalNtwin + hardeningTwin: do j = 1_pInt, prm%totalNtwin dst%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/prm%shear_twin(j) dst%accshear_twin(j,of) = abs(gdot_twin(j)) - enddo + enddo hardeningTwin + end associate end subroutine plastic_phenopowerlaw_dotState +!-------------------------------------------------------------------------------------------------- +!> @brief calculates shear rates on slip systems +!-------------------------------------------------------------------------------------------------- +subroutine shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) + + implicit none + type(tParameters), intent(in) :: & + prm + type(tPhenopowerlawState), intent(in) :: & + stt + integer(pInt), intent(in) :: & + of + real, dimension(prm%totalNslip), intent(in) :: & + tau_slip_pos, & + tau_slip_neg + real, dimension(prm%totalNslip), intent(out) :: & + gdot_slip_pos, & + gdot_slip_neg + + integer(pInt) :: j + + gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & + * sign(abs(tau_slip_pos/stt%s_slip(:,of))**prm%n_slip, tau_slip_pos) + gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & + * sign(abs(tau_slip_neg/stt%s_slip(:,of))**prm%n_slip, tau_slip_neg) + +end subroutine shearRates_slip + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates shear rates on twin systems +!-------------------------------------------------------------------------------------------------- +subroutine shearRates_twin(prm,stt,of,tau_twin,gdot_twin) + + implicit none + type(tParameters), intent(in) :: & + prm + type(tPhenopowerlawState), intent(in) :: & + stt + integer(pInt), intent(in) :: & + of + real, dimension(prm%totalNtwin), intent(in) :: & + tau_twin + real, dimension(prm%totalNtwin), intent(out) :: & + gdot_twin + + gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin * & + (abs(tau_twin)/stt%s_twin(:,of))**prm%n_twin, & + 0.0_pReal, tau_twin>0.0_pReal) +end subroutine shearRates_twin + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates resolved stress on slip systems +!-------------------------------------------------------------------------------------------------- +subroutine resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) + use math, only: & + math_mul33xx33 + + implicit none + type(tParameters), intent(in) :: & + prm + real(pReal), dimension(3,3), intent(in) :: & + S + real, dimension(prm%totalNslip), intent(out) :: & + tau_slip_pos, & + tau_slip_neg + + integer(pInt) :: j, k + + do j = 1_pInt, prm%totalNslip + tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) + tau_slip_neg = tau_slip_pos + do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) + enddo + enddo + +end subroutine resolvedStress_slip + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates resolved stress on twin systems +!-------------------------------------------------------------------------------------------------- +subroutine resolvedStress_twin(prm,S,tau_twin) + use math, only: & + math_mul33xx33 + + implicit none + type(tParameters), intent(in) :: & + prm + real(pReal), dimension(3,3), intent(in) :: & + S + real, dimension(prm%totalNtwin), intent(out) :: & + tau_twin + + integer(pInt) :: j + + do j = 1_pInt, prm%totalNtwin + tau_twin(j) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) + enddo +end subroutine resolvedStress_twin + + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- @@ -726,8 +817,11 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) integer(pInt) :: & of, & o,c,j,k - real(pReal) :: & - tau_slip_pos,tau_slip_neg,tau_twin + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + tau_slip_pos,tau_slip_neg, & + gdot_slip_pos,gdot_slip_neg + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & + gdot_twin,tau_twin type(tParameters) :: prm type(tPhenopowerlawState) :: stt @@ -751,23 +845,14 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) c = c + prm%totalNslip case (shearrate_slip_ID) - do j = 1_pInt, prm%totalNslip - tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) - tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) - enddo nonSchmidSystems - postResults(c+j) = prm%gdot0_slip*0.5_pReal* & - ( sign(abs(tau_slip_pos/stt%s_slip(j,of))**prm%n_slip, tau_slip_pos) & - +sign(abs(tau_slip_neg/stt%s_slip(j,of))**prm%n_slip, tau_slip_neg)) - enddo + call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) + call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) + postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg c = c + prm%totalNslip case (resolvedstress_slip_ID) - do j = 1_pInt, prm%totalNslip - postResults(c+j) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) - enddo + call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) + postResults(c+1_pInt:c+prm%totalNslip) = 0.5_pReal*(tau_slip_pos+tau_slip_neg) c = c + prm%totalNslip case (totalshear_ID) @@ -783,18 +868,14 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) c = c + prm%totalNtwin case (shearrate_twin_ID) - do j = 1_pInt, prm%totalNtwin - tau_twin = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) - postResults(c+j) = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin * & - (abs(tau_twin)/stt%s_twin(j,of))**prm%n_twin, & - 0.0_pReal, tau_twin>0.0_pReal) - enddo + call resolvedStress_twin(prm,S,tau_twin) + call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) + postResults(c+1_pInt:c+prm%totalNtwin) = gdot_twin c = c + prm%totalNtwin case (resolvedstress_twin_ID) - do j = 1_pInt, prm%totalNtwin - postResults(c+j) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) - enddo + call resolvedStress_twin(prm,S,tau_twin) + postResults(c+1_pInt:c+prm%totalNtwin) = tau_twin c = c + prm%totalNtwin case (totalvolfrac_twin_ID) From 33526112670e6fe1b11150315d72935f82b1edb5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 09:59:09 +0200 Subject: [PATCH 22/41] cleaning --- src/plastic_phenopowerlaw.f90 | 60 +++++++++++++++-------------------- 1 file changed, 25 insertions(+), 35 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3a4195773..76a327618 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -495,7 +495,6 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, use prec, only: & dNeq0 use math, only: & - math_mul33xx33,& math_Mandel6to33, & math_Plain3333to99 use material, only: & @@ -570,7 +569,6 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) twinSystems: do j = 1_pInt, prm%totalNtwin Lp = Lp + gdot_twin(j)*prm%Schmid_twin(1:3,1:3,j) - if (dNeq0(gdot_twin(j))) then dgdot_dtautwin = gdot_twin(j)*prm%n_twin/tau_twin(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & @@ -590,7 +588,6 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) use math, only: & - math_mul33xx33, & math_Mandel6to33 use material, only: & material_phase, & @@ -617,7 +614,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & - gdot_slip,left_SlipSlip,right_SlipSlip + gdot_slip_abs,left_SlipSlip,right_SlipSlip real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & tau_slip_pos,tau_slip_neg, & gdot_slip_pos,gdot_slip_neg @@ -635,14 +632,6 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dst%whole(:,of) = 0.0_pReal S = math_Mandel6to33(Mstar6) -!-------------------------------------------------------------------------------------------------- -! shear rates - call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) - call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) - gdot_slip = 0.5_pReal*(gdot_slip_pos+gdot_slip_neg) - call resolvedStress_twin(prm,S,tau_twin) - call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) - !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices c_SlipSlip = prm%h0_slipslip * (1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) @@ -659,20 +648,28 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) enddo slipSystems +!-------------------------------------------------------------------------------------------------- +! shear rates + call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) + call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) + gdot_slip_abs = abs(0.5_pReal*(gdot_slip_pos+gdot_slip_neg)) + call resolvedStress_twin(prm,S,tau_twin) + call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) + !-------------------------------------------------------------------------------------------------- ! hardening hardeningSlip: do j = 1_pInt, prm%totalNslip - dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j - dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor + dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*gdot_slip_abs) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) enddo hardeningSlip - dst%sumGamma(of) = dst%sumGamma(of) + sum(abs(gdot_slip)) - dst%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) + dst%sumGamma(of) = dst%sumGamma(of) + sum(gdot_slip_abs) + dst%accshear_slip(1:prm%totalNslip,of) = gdot_slip_abs hardeningTwin: do j = 1_pInt, prm%totalNtwin - dst%s_twin(j,of) = & ! evolution of twin resistance j - c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor + dst%s_twin(j,of) = & + c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),gdot_slip_abs) + & + c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/prm%shear_twin(j) dst%accshear_twin(j,of) = abs(gdot_twin(j)) @@ -702,8 +699,6 @@ subroutine shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gd gdot_slip_pos, & gdot_slip_neg - integer(pInt) :: j - gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & * sign(abs(tau_slip_pos/stt%s_slip(:,of))**prm%n_slip, tau_slip_pos) gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & @@ -729,9 +724,9 @@ subroutine shearRates_twin(prm,stt,of,tau_twin,gdot_twin) real, dimension(prm%totalNtwin), intent(out) :: & gdot_twin - gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin * & - (abs(tau_twin)/stt%s_twin(:,of))**prm%n_twin, & + gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(:,of))**prm%n_twin, & 0.0_pReal, tau_twin>0.0_pReal) + end subroutine shearRates_twin @@ -785,6 +780,7 @@ subroutine resolvedStress_twin(prm,S,tau_twin) do j = 1_pInt, prm%totalNtwin tau_twin(j) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) enddo + end subroutine resolvedStress_twin @@ -816,7 +812,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) integer(pInt) :: & of, & - o,c,j,k + o,c real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & tau_slip_pos,tau_slip_neg, & gdot_slip_pos,gdot_slip_neg @@ -836,43 +832,34 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) + case (resistance_slip_ID) postResults(c+1_pInt:c+prm%totalNslip) = stt%s_slip(1:prm%totalNslip,of) c = c + prm%totalNslip - case (accumulatedshear_slip_ID) postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) c = c + prm%totalNslip - case (shearrate_slip_ID) call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg c = c + prm%totalNslip - case (resolvedstress_slip_ID) call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) postResults(c+1_pInt:c+prm%totalNslip) = 0.5_pReal*(tau_slip_pos+tau_slip_neg) c = c + prm%totalNslip - case (totalshear_ID) - postResults(c+1_pInt) = stt%sumGamma(of) - c = c + 1_pInt - case (resistance_twin_ID) postResults(c+1_pInt:c+prm%totalNtwin) = stt%s_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin - case (accumulatedshear_twin_ID) postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin - case (shearrate_twin_ID) call resolvedStress_twin(prm,S,tau_twin) call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) postResults(c+1_pInt:c+prm%totalNtwin) = gdot_twin c = c + prm%totalNtwin - case (resolvedstress_twin_ID) call resolvedStress_twin(prm,S,tau_twin) postResults(c+1_pInt:c+prm%totalNtwin) = tau_twin @@ -881,6 +868,9 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) case (totalvolfrac_twin_ID) postResults(c+1_pInt) = stt%sumF(of) c = c + 1_pInt + case (totalshear_ID) + postResults(c+1_pInt) = stt%sumGamma(of) + c = c + 1_pInt end select enddo outputsLoop From 8a406150f898d607a79b69a5bfa5822897d17471 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 10:06:04 +0200 Subject: [PATCH 23/41] polishing --- src/plastic_phenopowerlaw.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 76a327618..c5c85f090 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -614,8 +614,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & - gdot_slip_abs,left_SlipSlip,right_SlipSlip - real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + gdot_slip_abs,left_SlipSlip,right_SlipSlip, & tau_slip_pos,tau_slip_neg, & gdot_slip_pos,gdot_slip_neg real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & @@ -652,7 +651,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) ! shear rates call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) - gdot_slip_abs = abs(0.5_pReal*(gdot_slip_pos+gdot_slip_neg)) + gdot_slip_abs = abs(gdot_slip_pos+gdot_slip_neg) call resolvedStress_twin(prm,S,tau_twin) call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) From 2337dde5258d03edf4ab57c823bdfbe00ae6e95a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 11:26:59 +0200 Subject: [PATCH 24/41] cleaning --- src/plastic_phenopowerlaw.f90 | 39 +++++++++++++++++------------------ 1 file changed, 19 insertions(+), 20 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index c5c85f090..db957d4d6 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -614,11 +614,11 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & - gdot_slip_abs,left_SlipSlip,right_SlipSlip, & + left_SlipSlip,right_SlipSlip, & tau_slip_pos,tau_slip_neg, & gdot_slip_pos,gdot_slip_neg real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & - gdot_twin,tau_twin + tau_twin type(tParameters) :: prm type(tPhenopowerlawState) :: dst,stt @@ -639,39 +639,38 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors + left_SlipSlip = 1.0_pReal + prm%H_int ssat_offset = prm%spr*sqrt(stt%sumF(of)) - slipSystems: do j = 1_pInt, prm%totalNslip - left_SlipSlip(j) = 1.0_pReal + prm%H_int(j) ! modified no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) **prm%a_slip & - * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(j)+ssat_offset)) - - enddo slipSystems + right_SlipSlip = abs(1.0_pReal-stt%s_slip(:,of) / (prm%tausat_slip+ssat_offset)) **prm%a_slip & + * sign(1.0_pReal,1.0_pReal-stt%s_slip(:,of) / (prm%tausat_slip+ssat_offset)) !-------------------------------------------------------------------------------------------------- ! shear rates call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) - gdot_slip_abs = abs(gdot_slip_pos+gdot_slip_neg) + dst%accshear_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) + dst%sumGamma(of) = sum(dst%accshear_slip(:,of)) call resolvedStress_twin(prm,S,tau_twin) - call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) + call shearRates_twin(prm,stt,of,tau_twin,dst%accshear_twin(:,of)) + if (stt%sumF(of) < 0.98_pReal) dst%sumF(of) = sum(dst%accshear_twin(:,of)/prm%shear_twin) !-------------------------------------------------------------------------------------------------- ! hardening hardeningSlip: do j = 1_pInt, prm%totalNslip - dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & - dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*gdot_slip_abs) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) + dst%s_slip(j,of) = & + c_SlipSlip * left_SlipSlip(j) & + * dot_product(prm%interaction_SlipSlip(j,:),right_SlipSlip*dst%accshear_slip(:,of)) & + + & + dot_product(prm%interaction_SlipTwin(j,:),dst%accshear_twin(:,of)) enddo hardeningSlip - dst%sumGamma(of) = dst%sumGamma(of) + sum(gdot_slip_abs) - dst%accshear_slip(1:prm%totalNslip,of) = gdot_slip_abs hardeningTwin: do j = 1_pInt, prm%totalNtwin dst%s_twin(j,of) = & - c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),gdot_slip_abs) + & - c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) - if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/prm%shear_twin(j) - dst%accshear_twin(j,of) = abs(gdot_twin(j)) + c_TwinSlip & + * dot_product(prm%interaction_TwinSlip(j,:),dst%accshear_slip(:,of)) & + + & + c_TwinTwin & + * dot_product(prm%interaction_TwinTwin(j,:),dst%accshear_twin(:,of)) enddo hardeningTwin end associate From 253f318e55e0bc44a0d2db367e65e26b8f4aef23 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 11:47:35 +0200 Subject: [PATCH 25/41] preventing NaN in dotState --- src/plastic_phenopowerlaw.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index db957d4d6..3b41db412 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -440,6 +440,7 @@ subroutine plastic_phenopowerlaw_init startIndex = 1_pInt endIndex = prm%totalNslip state (instance)%s_slip => plasticState(p)%state (startIndex:endIndex,:) + state (instance)%s_slip = spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) dotState(instance)%s_slip => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) @@ -448,6 +449,7 @@ subroutine plastic_phenopowerlaw_init startIndex = endIndex + 1_pInt endIndex = endIndex + prm%totalNtwin state (instance)%s_twin => plasticState(p)%state (startIndex:endIndex,:) + state (instance)%s_twin = spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) dotState(instance)%s_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) From c9b5b3fb7b2901310a6676da64859003e7570ff6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 12:08:03 +0200 Subject: [PATCH 26/41] should be always set, even if no twinning is enabled fixes NaN in dotState --- src/plastic_phenopowerlaw.f90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3b41db412..3613f82b8 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -220,10 +220,6 @@ subroutine plastic_phenopowerlaw_init prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') prm%n_twin = config_phase(p)%getFloat('n_twin') prm%spr = config_phase(p)%getFloat('s_pr') - prm%twinB = config_phase(p)%getFloat('twin_b') - prm%twinC = config_phase(p)%getFloat('twin_c') - prm%twinD = config_phase(p)%getFloat('twin_d') - prm%twinE = config_phase(p)%getFloat('twin_e') prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') endif @@ -233,6 +229,11 @@ subroutine plastic_phenopowerlaw_init prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') endif + prm%twinB = config_phase(p)%getFloat('twin_b',defaultVal=1.0_pReal) + prm%twinC = config_phase(p)%getFloat('twin_c',defaultVal=0.0_pReal) + prm%twinD = config_phase(p)%getFloat('twin_d',defaultVal=0.0_pReal) + prm%twinE = config_phase(p)%getFloat('twin_e',defaultVal=0.0_pReal) + prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) From edebe4d1edb513f5d4a9e713e65410f16a446b20 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 12:26:33 +0200 Subject: [PATCH 27/41] vectorization error --- src/plastic_phenopowerlaw.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3613f82b8..40bf619a3 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -747,14 +747,14 @@ subroutine resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) tau_slip_pos, & tau_slip_neg - integer(pInt) :: j, k + integer(pInt) :: i,j - do j = 1_pInt, prm%totalNslip - tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) - tau_slip_neg = tau_slip_pos - do k = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,k,j)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,k,j)) + do i = 1_pInt, prm%totalNslip + tau_slip_pos(i) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,i)) + tau_slip_neg(i) = tau_slip_pos(i) + do j = 1,size(prm%nonSchmidCoeff) + tau_slip_pos(i) = tau_slip_pos(i) + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,j,i)) + tau_slip_neg(i) = tau_slip_neg(i) + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,j,i)) enddo enddo @@ -776,10 +776,10 @@ subroutine resolvedStress_twin(prm,S,tau_twin) real, dimension(prm%totalNtwin), intent(out) :: & tau_twin - integer(pInt) :: j + integer(pInt) :: i - do j = 1_pInt, prm%totalNtwin - tau_twin(j) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,j)) + do i = 1_pInt, prm%totalNtwin + tau_twin(i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) enddo end subroutine resolvedStress_twin From 3068caa9a3608259ff54b632679197be5edf7d98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Sep 2018 13:05:23 +0200 Subject: [PATCH 28/41] [skip sc] resolved stress not needed using kinetics_xxx as in disloUCLA compiles on gfortran but pre-receive hook with intel compiler (MSC.Marc) fails --- src/plastic_phenopowerlaw.f90 | 218 ++++++++++++++++------------------ 1 file changed, 102 insertions(+), 116 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 40bf619a3..d6d9614ed 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -495,8 +495,6 @@ end subroutine plastic_phenopowerlaw_init !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip,el) - use prec, only: & - dNeq0 use math, only: & math_Mandel6to33, & math_Plain3333to99 @@ -519,70 +517,55 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, Mstar_v !< Mandel stress integer(pInt) :: & - index_myFamily, & j,k,l,m,n, & of - real(pReal) :: & - dgdot_dtauslip_pos,dgdot_dtauslip_neg, & - dgdot_dtautwin real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress real(pReal), dimension(3,3,3,3) :: & dLp_dS !< derivative of Lp with respect to Mstar as 4th order tensor real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & - tau_slip_pos,tau_slip_neg, & + dgdot_dtauslip_pos,dgdot_dtauslip_neg, & gdot_slip_pos,gdot_slip_neg real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & - gdot_twin,tau_twin + gdot_twin,dgdot_dtautwin type(tParameters) :: prm type(tPhenopowerlawState) :: stt +! BEGIN DEPRECATED of = phasememberAt(ipc,ip,el) - + S = math_Mandel6to33(Mstar_v) associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) +! END DEPRECATED Lp = 0.0_pReal dLp_dS = 0.0_pReal - S = math_Mandel6to33(Mstar_v) - - call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) - call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) + call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) slipSystems: do j = 1_pInt, prm%totalNslip Lp = Lp + (1.0_pReal-stt%sumF(of))*(gdot_slip_pos(j)+gdot_slip_neg(j))*prm%Schmid_slip(1:3,1:3,j) - if (dNeq0(tau_slip_pos(j))) then - dgdot_dtauslip_pos = gdot_slip_pos(j)*prm%n_slip/tau_slip_pos(j) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtauslip_pos * prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) - endif - if (dNeq0(tau_slip_neg(j))) then - dgdot_dtauslip_neg = gdot_slip_neg(j)*prm%n_slip/tau_slip_neg(j) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtauslip_neg * prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) - endif + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + + dgdot_dtauslip_pos(j) * prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + + dgdot_dtauslip_neg(j) * prm%Schmid_slip(k,l,j) & + *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) enddo slipSystems - call resolvedStress_twin(prm,S,tau_twin) - call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) + call kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtautwin) twinSystems: do j = 1_pInt, prm%totalNtwin Lp = Lp + gdot_twin(j)*prm%Schmid_twin(1:3,1:3,j) - if (dNeq0(gdot_twin(j))) then - dgdot_dtautwin = gdot_twin(j)*prm%n_twin/tau_twin(j) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtautwin*prm%Schmid_twin(k,l,j)*prm%Schmid_twin(m,n,j) - endif + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & + + dgdot_dtautwin(j)*prm%Schmid_twin(k,l,j)*prm%Schmid_twin(m,n,j) enddo twinSystems - - dLp_dMstar99 = math_Plain3333to99(dLp_dS) - end associate + + dLp_dMstar99 = math_Plain3333to99(dLp_dS) ! DEPRECATED + end subroutine plastic_phenopowerlaw_LpAndItsTangent @@ -608,7 +591,6 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) integer(pInt) :: & ph, & j,k, & - index_myFamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & @@ -618,10 +600,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) S !< Second-Piola Kirchhoff stress real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & left_SlipSlip,right_SlipSlip, & - tau_slip_pos,tau_slip_neg, & gdot_slip_pos,gdot_slip_neg - real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & - tau_twin type(tParameters) :: prm type(tPhenopowerlawState) :: dst,stt @@ -649,12 +628,10 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! shear rates - call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) - call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) + call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg) dst%accshear_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) dst%sumGamma(of) = sum(dst%accshear_slip(:,of)) - call resolvedStress_twin(prm,S,tau_twin) - call shearRates_twin(prm,stt,of,tau_twin,dst%accshear_twin(:,of)) + call kinetics_twin(prm,stt,of,S,dst%accshear_twin(:,of)) if (stt%sumF(of) < 0.98_pReal) dst%sumF(of) = sum(dst%accshear_twin(:,of)/prm%shear_twin) !-------------------------------------------------------------------------------------------------- @@ -684,70 +661,34 @@ end subroutine plastic_phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on slip systems !-------------------------------------------------------------------------------------------------- -subroutine shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) - - implicit none - type(tParameters), intent(in) :: & - prm - type(tPhenopowerlawState), intent(in) :: & - stt - integer(pInt), intent(in) :: & - of - real, dimension(prm%totalNslip), intent(in) :: & - tau_slip_pos, & - tau_slip_neg - real, dimension(prm%totalNslip), intent(out) :: & - gdot_slip_pos, & - gdot_slip_neg - - gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & - * sign(abs(tau_slip_pos/stt%s_slip(:,of))**prm%n_slip, tau_slip_pos) - gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & - * sign(abs(tau_slip_neg/stt%s_slip(:,of))**prm%n_slip, tau_slip_neg) - -end subroutine shearRates_slip - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on twin systems -!-------------------------------------------------------------------------------------------------- -subroutine shearRates_twin(prm,stt,of,tau_twin,gdot_twin) - - implicit none - type(tParameters), intent(in) :: & - prm - type(tPhenopowerlawState), intent(in) :: & - stt - integer(pInt), intent(in) :: & - of - real, dimension(prm%totalNtwin), intent(in) :: & - tau_twin - real, dimension(prm%totalNtwin), intent(out) :: & - gdot_twin - - gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(:,of))**prm%n_twin, & - 0.0_pReal, tau_twin>0.0_pReal) - -end subroutine shearRates_twin - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates resolved stress on slip systems -!-------------------------------------------------------------------------------------------------- -subroutine resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) +subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & + dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) + use prec, only: & + dNeq0 use math, only: & math_mul33xx33 implicit none type(tParameters), intent(in) :: & prm + type(tPhenopowerlawState), intent(in) :: & + stt + integer(pInt), intent(in) :: & + of + real, dimension(prm%totalNslip), intent(out) :: & + gdot_slip_pos, & + gdot_slip_neg + real, dimension(prm%totalNslip), optional, intent(out) :: & + dgdot_dtau_slip_pos, & + dgdot_dtau_slip_neg real(pReal), dimension(3,3), intent(in) :: & S - real, dimension(prm%totalNslip), intent(out) :: & + + real, dimension(prm%totalNslip) :: & tau_slip_pos, & tau_slip_neg - integer(pInt) :: i,j + integer(pInt) :: i, j do i = 1_pInt, prm%totalNslip tau_slip_pos(i) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,i)) @@ -758,31 +699,70 @@ subroutine resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) enddo enddo -end subroutine resolvedStress_slip + + gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & + * sign(abs(tau_slip_pos/stt%s_slip(:,of))**prm%n_slip, tau_slip_pos) + gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & + * sign(abs(tau_slip_neg/stt%s_slip(:,of))**prm%n_slip, tau_slip_neg) + + if (present(dgdot_dtau_slip_pos)) then + where(dNeq0(tau_slip_pos)) + dgdot_dtau_slip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos + else where + dgdot_dtau_slip_pos = 0.0_pReal + end where + endif + if (present(dgdot_dtau_slip_neg)) then + where(dNeq0(tau_slip_neg)) + dgdot_dtau_slip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg + else where + dgdot_dtau_slip_neg = 0.0_pReal + end where + endif + +end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- -!> @brief calculates resolved stress on twin systems +!> @brief calculates shear rates on twin systems !-------------------------------------------------------------------------------------------------- -subroutine resolvedStress_twin(prm,S,tau_twin) +subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) + use prec, only: & + dNeq0 use math, only: & math_mul33xx33 implicit none type(tParameters), intent(in) :: & prm + type(tPhenopowerlawState), intent(in) :: & + stt + integer(pInt), intent(in) :: & + of real(pReal), dimension(3,3), intent(in) :: & S real, dimension(prm%totalNtwin), intent(out) :: & + gdot_twin + real, dimension(prm%totalNtwin), optional, intent(out) :: & + dgdot_dtau_twin + + real, dimension(prm%totalNtwin) :: & tau_twin - integer(pInt) :: i - do i = 1_pInt, prm%totalNtwin tau_twin(i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) enddo + gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(:,of))**prm%n_twin, & + 0.0_pReal, tau_twin>0.0_pReal) + if (present(dgdot_dtau_twin)) then + where(dNeq0(tau_twin)) + dgdot_dtau_twin = gdot_twin*prm%n_twin/tau_twin + else where + dgdot_dtau_twin = 0.0_pReal + end where + endif -end subroutine resolvedStress_twin +end subroutine kinetics_twin !-------------------------------------------------------------------------------------------------- @@ -813,9 +793,10 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) integer(pInt) :: & of, & - o,c + o,c,i,j + real(pReal) :: & + tau_slip_pos, tau_slip_neg real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & - tau_slip_pos,tau_slip_neg, & gdot_slip_pos,gdot_slip_neg real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & gdot_twin,tau_twin @@ -841,13 +822,19 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (shearrate_slip_ID) - call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) - call shearRates_slip(prm,stt,of,tau_slip_pos,tau_slip_neg,gdot_slip_pos,gdot_slip_neg) + call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg) postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg c = c + prm%totalNslip case (resolvedstress_slip_ID) - call resolvedStress_slip(prm,S,tau_slip_pos,tau_slip_neg) - postResults(c+1_pInt:c+prm%totalNslip) = 0.5_pReal*(tau_slip_pos+tau_slip_neg) + do i = 1_pInt, prm%totalNslip + tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,i)) + tau_slip_neg = tau_slip_pos + do j = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,j,i)) + tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,j,i)) + enddo + postResults(c+i) = 0.5_pReal*(tau_slip_pos+tau_slip_neg) + enddo c = c + prm%totalNslip case (resistance_twin_ID) @@ -857,13 +844,12 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (shearrate_twin_ID) - call resolvedStress_twin(prm,S,tau_twin) - call shearRates_twin(prm,stt,of,tau_twin,gdot_twin) - postResults(c+1_pInt:c+prm%totalNtwin) = gdot_twin + call kinetics_twin(prm,stt,of,S,postResults(c+1_pInt:c+prm%totalNtwin)) c = c + prm%totalNtwin case (resolvedstress_twin_ID) - call resolvedStress_twin(prm,S,tau_twin) - postResults(c+1_pInt:c+prm%totalNtwin) = tau_twin + do i = 1_pInt, prm%totalNtwin + postResults(c+i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) + enddo c = c + prm%totalNtwin case (totalvolfrac_twin_ID) From 4266872965bcab6aa4fc5eb497e6aba6a3c3c9d7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 13 Sep 2018 05:41:44 +0200 Subject: [PATCH 29/41] array out of bounds was possible for Ntwin =0 in postResults(c+1:c+prm%totalNtwin) c+1 will be out of bounds if c is already size(postResults) --- src/plastic_phenopowerlaw.f90 | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index d6d9614ed..a7e22db77 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -244,36 +244,36 @@ subroutine plastic_phenopowerlaw_init outputID = undefined_ID select case(outputs(i)) case ('resistance_slip') - outputID = resistance_slip_ID + outputID = merge(resistance_slip_ID,undefined_ID,prm%totalNslip>0_pInt) outputSize = prm%totalNslip case ('accumulatedshear_slip') - outputID = accumulatedshear_slip_ID + outputID = merge(accumulatedshear_slip_ID,undefined_ID,prm%totalNslip>0_pInt) outputSize = prm%totalNslip case ('shearrate_slip') - outputID = shearrate_slip_ID + outputID = merge(shearrate_slip_ID,undefined_ID,prm%totalNslip>0_pInt) outputSize = prm%totalNslip case ('resolvedstress_slip') - outputID = resolvedstress_slip_ID + outputID = merge(resolvedstress_slip_ID,undefined_ID,prm%totalNslip>0_pInt) outputSize = prm%totalNslip case ('resistance_twin') - outputID = resistance_twin_ID + outputID = merge(resistance_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) outputSize = prm%totalNtwin case ('accumulatedshear_twin') - outputID = accumulatedshear_twin_ID + outputID = merge(accumulatedshear_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) outputSize = prm%totalNtwin case ('shearrate_twin') - outputID = shearrate_twin_ID + outputID = merge(shearrate_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) outputSize = prm%totalNtwin case ('resolvedstress_twin') - outputID = resolvedstress_twin_ID + outputID = merge(resolvedstress_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) outputSize = prm%totalNtwin - case ('totalvolfrac_twin') - outputID = totalvolfrac_twin_ID - outputSize = 1_pInt case ('totalshear') - outputID = totalshear_ID + outputID = merge(totalshear_ID,undefined_ID,prm%totalNslip>0_pInt) + outputSize = 1_pInt + case ('totalvolfrac_twin') + outputID = merge(totalvolfrac_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) outputSize = 1_pInt end select @@ -798,8 +798,6 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) tau_slip_pos, tau_slip_neg real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & gdot_slip_pos,gdot_slip_neg - real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & - gdot_twin,tau_twin type(tParameters) :: prm type(tPhenopowerlawState) :: stt @@ -852,12 +850,12 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) enddo c = c + prm%totalNtwin - case (totalvolfrac_twin_ID) - postResults(c+1_pInt) = stt%sumF(of) - c = c + 1_pInt case (totalshear_ID) postResults(c+1_pInt) = stt%sumGamma(of) c = c + 1_pInt + case (totalvolfrac_twin_ID) + postResults(c+1_pInt) = stt%sumF(of) + c = c + 1_pInt end select enddo outputsLoop From 8ecb019566829a59125b1b6a9dd28fce889945e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 13 Sep 2018 05:49:57 +0200 Subject: [PATCH 30/41] real must be pReal for MSC.Marc --- src/plastic_phenopowerlaw.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a7e22db77..6d68f07ca 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -675,16 +675,16 @@ subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & stt integer(pInt), intent(in) :: & of - real, dimension(prm%totalNslip), intent(out) :: & + real(pReal), dimension(prm%totalNslip), intent(out) :: & gdot_slip_pos, & gdot_slip_neg - real, dimension(prm%totalNslip), optional, intent(out) :: & + real(pReal), dimension(prm%totalNslip), optional, intent(out) :: & dgdot_dtau_slip_pos, & dgdot_dtau_slip_neg real(pReal), dimension(3,3), intent(in) :: & S - real, dimension(prm%totalNslip) :: & + real(pReal), dimension(prm%totalNslip) :: & tau_slip_pos, & tau_slip_neg @@ -741,14 +741,15 @@ subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) of real(pReal), dimension(3,3), intent(in) :: & S - real, dimension(prm%totalNtwin), intent(out) :: & + real(pReal), dimension(prm%totalNtwin), intent(out) :: & gdot_twin - real, dimension(prm%totalNtwin), optional, intent(out) :: & + real(pReal), dimension(prm%totalNtwin), optional, intent(out) :: & dgdot_dtau_twin - real, dimension(prm%totalNtwin) :: & + real(pReal), dimension(prm%totalNtwin) :: & tau_twin integer(pInt) :: i + do i = 1_pInt, prm%totalNtwin tau_twin(i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) enddo From b165e48d9f38a52c6adfec5e165f9bead84cb6f8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Sep 2018 05:21:05 +0200 Subject: [PATCH 31/41] non-Schmid contribution were ignored in test reverted, just to ensure that the results have not changed: Never polishing and change physics at the same time --- src/plastic_phenopowerlaw.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 6d68f07ca..318124e22 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -699,7 +699,6 @@ subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & enddo enddo - gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & * sign(abs(tau_slip_pos/stt%s_slip(:,of))**prm%n_slip, tau_slip_pos) gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & @@ -828,10 +827,10 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) do i = 1_pInt, prm%totalNslip tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,i)) tau_slip_neg = tau_slip_pos - do j = 1,size(prm%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,j,i)) - tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,j,i)) - enddo + !do j = 1,size(prm%nonSchmidCoeff) + ! tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,j,i)) + ! tau_slip_neg = tau_slip_neg + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,j,i)) + !enddo postResults(c+i) = 0.5_pReal*(tau_slip_pos+tau_slip_neg) enddo c = c + prm%totalNslip From e2a66f6ddb63b91a507ec21fd0f2ea17558f835c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Sep 2018 05:33:39 +0200 Subject: [PATCH 32/41] should not differ from development --- src/constitutive.f90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 89d724bda..43207c65c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -483,8 +483,7 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v real(pReal), dimension(9,9) :: & dLp_dMstar !< derivative of Lp with respect to Mstar (4th-order tensor) real(pReal), dimension(3,3) :: & - temp_33, & - Mstar + temp_33 integer(pInt) :: & ho, & !< homogenization tme !< thermal member position @@ -494,8 +493,7 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v ho = material_homog(ip,el) tme = thermalMapping(ho)%p(ip,el) - Mstar = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(Tstar_v)) - Mstar_v = math_Mandel33to6(Mstar) + Mstar_v = math_Mandel33to6(math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(Tstar_v))) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_NONE_ID) plasticityType From 18858301d5f1b535e4c58c49e32081736422f91e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Sep 2018 09:59:04 +0200 Subject: [PATCH 33/41] using consistently i as first running index and j as second --- src/plastic_phenopowerlaw.f90 | 40 +++++++++++++++++------------------ 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 318124e22..ddf136b25 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -517,7 +517,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, Mstar_v !< Mandel stress integer(pInt) :: & - j,k,l,m,n, & + i,k,l,m,n, & of real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress @@ -543,24 +543,24 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, dLp_dS = 0.0_pReal call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) - slipSystems: do j = 1_pInt, prm%totalNslip - Lp = Lp + (1.0_pReal-stt%sumF(of))*(gdot_slip_pos(j)+gdot_slip_neg(j))*prm%Schmid_slip(1:3,1:3,j) + slipSystems: do i = 1_pInt, prm%totalNslip + Lp = Lp + (1.0_pReal-stt%sumF(of))*(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_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtauslip_pos(j) * prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_pos(m,n,:,j))) + + dgdot_dtauslip_pos(i) * prm%Schmid_slip(k,l,i) & + *(prm%Schmid_slip(m,n,i) + sum(prm%nonSchmid_pos(m,n,:,i))) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtauslip_neg(j) * prm%Schmid_slip(k,l,j) & - *(prm%Schmid_slip(m,n,j) + sum(prm%nonSchmid_neg(m,n,:,j))) + + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) & + *(prm%Schmid_slip(m,n,i) + sum(prm%nonSchmid_neg(m,n,:,i))) enddo slipSystems call kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtautwin) - twinSystems: do j = 1_pInt, prm%totalNtwin - Lp = Lp + gdot_twin(j)*prm%Schmid_twin(1:3,1:3,j) + twinSystems: do i = 1_pInt, prm%totalNtwin + Lp = Lp + gdot_twin(i)*prm%Schmid_twin(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_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtautwin(j)*prm%Schmid_twin(k,l,j)*prm%Schmid_twin(m,n,j) + + dgdot_dtautwin(i)*prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) enddo twinSystems end associate @@ -590,7 +590,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) integer(pInt) :: & ph, & - j,k, & + i,k, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & @@ -636,21 +636,21 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! hardening - hardeningSlip: do j = 1_pInt, prm%totalNslip - dst%s_slip(j,of) = & - c_SlipSlip * left_SlipSlip(j) & - * dot_product(prm%interaction_SlipSlip(j,:),right_SlipSlip*dst%accshear_slip(:,of)) & + hardeningSlip: do i = 1_pInt, prm%totalNslip + dst%s_slip(i,of) = & + c_SlipSlip * left_SlipSlip(i) & + * dot_product(prm%interaction_SlipSlip(i,:),right_SlipSlip*dst%accshear_slip(:,of)) & + & - dot_product(prm%interaction_SlipTwin(j,:),dst%accshear_twin(:,of)) + dot_product(prm%interaction_SlipTwin(i,:),dst%accshear_twin(:,of)) enddo hardeningSlip - hardeningTwin: do j = 1_pInt, prm%totalNtwin - dst%s_twin(j,of) = & + hardeningTwin: do i = 1_pInt, prm%totalNtwin + dst%s_twin(i,of) = & c_TwinSlip & - * dot_product(prm%interaction_TwinSlip(j,:),dst%accshear_slip(:,of)) & + * dot_product(prm%interaction_TwinSlip(i,:),dst%accshear_slip(:,of)) & + & c_TwinTwin & - * dot_product(prm%interaction_TwinTwin(j,:),dst%accshear_twin(:,of)) + * dot_product(prm%interaction_TwinTwin(i,:),dst%accshear_twin(:,of)) enddo hardeningTwin end associate From 07b0ddf711383ec14c69f239cb72939a9071faf8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Sep 2018 10:08:36 +0200 Subject: [PATCH 34/41] polishing --- src/plastic_phenopowerlaw.f90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index ddf136b25..94458a398 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -443,8 +443,6 @@ subroutine plastic_phenopowerlaw_init state (instance)%s_slip => plasticState(p)%state (startIndex:endIndex,:) state (instance)%s_slip = spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) dotState(instance)%s_slip => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%state0(startIndex:endIndex,:) = & - spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt @@ -452,8 +450,6 @@ subroutine plastic_phenopowerlaw_init state (instance)%s_twin => plasticState(p)%state (startIndex:endIndex,:) state (instance)%s_twin = spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) dotState(instance)%s_twin => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%state0(startIndex:endIndex,:) = & - spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt @@ -641,7 +637,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) c_SlipSlip * left_SlipSlip(i) & * dot_product(prm%interaction_SlipSlip(i,:),right_SlipSlip*dst%accshear_slip(:,of)) & + & - dot_product(prm%interaction_SlipTwin(i,:),dst%accshear_twin(:,of)) + dot_product(prm%interaction_SlipTwin(i,:),dst%accshear_twin(:,of)) enddo hardeningSlip hardeningTwin: do i = 1_pInt, prm%totalNtwin @@ -659,7 +655,9 @@ end subroutine plastic_phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on slip systems +!> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress +!> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the +!> result (i.e. intent(out)) variables are the last to have the optional arguments at the end !-------------------------------------------------------------------------------------------------- subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) @@ -723,7 +721,9 @@ end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on twin systems +!> @brief calculates shear rates on twin systems and derivatives with respect to resolved stress +!> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the +!> result (i.e. intent(out)) variables are the last to have the optional arguments at the end !-------------------------------------------------------------------------------------------------- subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) use prec, only: & @@ -753,7 +753,8 @@ subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) tau_twin(i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) enddo gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(:,of))**prm%n_twin, & - 0.0_pReal, tau_twin>0.0_pReal) + 0.0_pReal, tau_twin>0.0_pReal) + if (present(dgdot_dtau_twin)) then where(dNeq0(tau_twin)) dgdot_dtau_twin = gdot_twin*prm%n_twin/tau_twin @@ -808,7 +809,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) postResults = 0.0_pReal c = 0_pInt - S = math_Mandel6to33(Mstar6) + S = math_Mandel6to33(Mstar6) !DEPRECATED outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) From 3dd47eade99123ae5af11ee8fa0a18f129c46e0b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Sep 2018 10:18:44 +0200 Subject: [PATCH 35/41] just renaming, better readable... --- src/plastic_phenopowerlaw.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 94458a398..9839956fe 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -599,14 +599,14 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) gdot_slip_pos,gdot_slip_neg type(tParameters) :: prm - type(tPhenopowerlawState) :: dst,stt + type(tPhenopowerlawState) :: dot,stt of = phasememberAt(ipc,ip,el) associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))), & - dst => dotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) + dot => dotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) - dst%whole(:,of) = 0.0_pReal + dot%whole(:,of) = 0.0_pReal S = math_Mandel6to33(Mstar6) !-------------------------------------------------------------------------------------------------- @@ -625,28 +625,28 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! shear rates call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg) - dst%accshear_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) - dst%sumGamma(of) = sum(dst%accshear_slip(:,of)) - call kinetics_twin(prm,stt,of,S,dst%accshear_twin(:,of)) - if (stt%sumF(of) < 0.98_pReal) dst%sumF(of) = sum(dst%accshear_twin(:,of)/prm%shear_twin) + dot%accshear_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) + dot%sumGamma(of) = sum(dot%accshear_slip(:,of)) + call kinetics_twin(prm,stt,of,S,dot%accshear_twin(:,of)) + if (stt%sumF(of) < 0.98_pReal) dot%sumF(of) = sum(dot%accshear_twin(:,of)/prm%shear_twin) !-------------------------------------------------------------------------------------------------- ! hardening hardeningSlip: do i = 1_pInt, prm%totalNslip - dst%s_slip(i,of) = & + dot%s_slip(i,of) = & c_SlipSlip * left_SlipSlip(i) & - * dot_product(prm%interaction_SlipSlip(i,:),right_SlipSlip*dst%accshear_slip(:,of)) & + * dot_product(prm%interaction_SlipSlip(i,:),right_SlipSlip*dot%accshear_slip(:,of)) & + & - dot_product(prm%interaction_SlipTwin(i,:),dst%accshear_twin(:,of)) + dot_product(prm%interaction_SlipTwin(i,:),dot%accshear_twin(:,of)) enddo hardeningSlip hardeningTwin: do i = 1_pInt, prm%totalNtwin - dst%s_twin(i,of) = & + dot%s_twin(i,of) = & c_TwinSlip & - * dot_product(prm%interaction_TwinSlip(i,:),dst%accshear_slip(:,of)) & + * dot_product(prm%interaction_TwinSlip(i,:),dot%accshear_slip(:,of)) & + & c_TwinTwin & - * dot_product(prm%interaction_TwinTwin(i,:),dst%accshear_twin(:,of)) + * dot_product(prm%interaction_TwinTwin(i,:),dot%accshear_twin(:,of)) enddo hardeningTwin end associate From af32b3d85ba9477e4bb9df80f6987937fc72b2e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Sep 2018 10:51:44 +0200 Subject: [PATCH 36/41] reordering for easier overview --- src/plastic_phenopowerlaw.f90 | 119 +++++++++++++++++----------------- 1 file changed, 61 insertions(+), 58 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 9839956fe..7d93aa0cb 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -187,56 +187,99 @@ subroutine plastic_phenopowerlaw_init if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle instance = phase_plasticityInstance(p) associate(prm => param(instance)) + extmsg = '' - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) - if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') - if (any(lattice_NslipSystem(1:size(prm%Nslip),p)-prm%Nslip < 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) + if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) & + call IO_error(150_pInt,ext_msg='Nslip') + if (any(lattice_NslipSystem(1:size(prm%Nslip),p)-prm%Nslip < 0_pInt)) & + call IO_error(150_pInt,ext_msg='Nslip') if (prm%totalNslip > 0_pInt) then - prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') - prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') - prm%interaction_SlipSlip = spread(config_phase(p)%getFloats('interaction_slipslip'),2,1) - prm%H_int = config_phase(p)%getFloats('h_int',& - defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + ! reading in slip related parameters + prm%tau0_slip = config_phase(p)%getFloats('tau0_slip', requiredShape=shape(prm%Nslip)) + prm%tausat_slip = config_phase(p)%getFloats('tausat_slip', requiredShape=shape(prm%Nslip)) + prm%interaction_SlipSlip = spread(config_phase(p)%getFloats('interaction_slipslip', & + requiredShape=shape(prm%Nslip)),2,1) + prm%H_int = config_phase(p)%getFloats('h_int', requiredShape=shape(prm%Nslip), & + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& - defaultVal = emptyRealArray ) + defaultVal = emptyRealArray ) prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') prm%n_slip = config_phase(p)%getFloat('n_slip') prm%a_slip = config_phase(p)%getFloat('a_slip') prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') + + ! sanity checks for slip related parameters + if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_slip " + if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tausat_slip " + + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_slip " + if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//"a_slip " ! ToDo: negative values ok? + if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//"n_slip " ! ToDo: negative values ok? + + ! expand slip related parameters from system => family + prm%tau0_slip = math_expand(prm%tausat_slip,prm%Nslip) + prm%tausat_slip = math_expand(prm%tausat_slip,prm%Nslip) + prm%H_int = math_expand(prm%H_int,prm%Nslip) endif - prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) - if (size(prm%Ntwin) > count(lattice_NtwinSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') - if (any(lattice_NtwinSystem(1:size(prm%Ntwin),p)-prm%Ntwin < 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') + prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) prm%totalNtwin = sum(prm%Ntwin) + if (size(prm%Ntwin) > count(lattice_NtwinSystem(:,p) > 0_pInt)) & + call IO_error(150_pInt,ext_msg='Ntwin') + if (any(lattice_NtwinSystem(1:size(prm%Ntwin),p)-prm%Ntwin < 0_pInt)) & + call IO_error(150_pInt,ext_msg='Ntwin') if (prm%totalNtwin > 0_pInt) then - prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') - prm%interaction_TwinTwin = spread(config_phase(p)%getFloats('interaction_twintwin'),2,1) + ! reading in twin related parameters + prm%tau0_twin = config_phase(p)%getFloats('tau0_twin', requiredShape=shape(prm%Ntwin)) + prm%interaction_TwinTwin = spread(config_phase(p)%getFloats('interaction_twintwin', & + requiredShape=shape(prm%Ntwin)),2,1) prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') prm%n_twin = config_phase(p)%getFloat('n_twin') prm%spr = config_phase(p)%getFloat('s_pr') prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') + + ! sanity checks for twin related parameters + if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_slip " + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? + + ! expand slip related parameters from system => family + prm%tau0_twin = math_expand(prm%tau0_twin,prm%Ntwin) endif if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = spread(config_phase(p)%getFloats('interaction_sliptwin'),2,1) prm%interaction_TwinSlip = spread(config_phase(p)%getFloats('interaction_twinslip'),2,1) prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') + else + prm%h0_TwinSlip = 0.0_pReal endif + ! optional parameters that should be defined prm%twinB = config_phase(p)%getFloat('twin_b',defaultVal=1.0_pReal) prm%twinC = config_phase(p)%getFloat('twin_c',defaultVal=0.0_pReal) prm%twinD = config_phase(p)%getFloat('twin_d',defaultVal=0.0_pReal) prm%twinE = config_phase(p)%getFloat('twin_e',defaultVal=0.0_pReal) prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + prm%aTolShear = config_phase(p)%getFloat('atol_shear', defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac', defaultVal=1.0e-6_pReal) + + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " + + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) @@ -285,46 +328,6 @@ subroutine plastic_phenopowerlaw_init end do - extmsg = '' - if (prm%totalNslip > 0_pInt) then - if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') - - if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_slip " - if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tausat_slip " - - if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " - if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? - if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? - - prm%H_int = math_expand(prm%H_int,prm%Nslip) - prm%tausat_slip = math_expand(prm%tausat_slip,prm%Nslip) - endif - - if (prm%totalNtwin > 0_pInt) then - if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& - ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') - - if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_twin " - - if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " - if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? - endif - - if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " - if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " - if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " - - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') - !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase @@ -441,14 +444,14 @@ subroutine plastic_phenopowerlaw_init startIndex = 1_pInt endIndex = prm%totalNslip state (instance)%s_slip => plasticState(p)%state (startIndex:endIndex,:) - state (instance)%s_slip = spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) + state (instance)%s_slip = spread(prm%tau0_slip, 2, NipcMyPhase) dotState(instance)%s_slip => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + prm%totalNtwin state (instance)%s_twin => plasticState(p)%state (startIndex:endIndex,:) - state (instance)%s_twin = spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) + state (instance)%s_twin = spread(prm%tau0_twin, 2, NipcMyPhase) dotState(instance)%s_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance From 9f16cefd9fc43e98672c41f5982eb7343389626a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Sep 2018 11:09:55 +0200 Subject: [PATCH 37/41] renaming in accordance with the DAMASK paper --- src/plastic_phenopowerlaw.f90 | 154 +++++++++++++++++----------------- 1 file changed, 79 insertions(+), 75 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 7d93aa0cb..993b41ad9 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -57,12 +57,12 @@ module plastic_phenopowerlaw Nslip, & !< active number of slip systems per family Ntwin !< active number of twin systems per family real(pReal), dimension(:), allocatable :: & - tau0_slip, & !< initial critical shear stress for slip - tau0_twin, & !< initial critical shear stress for twin - tausat_slip, & !< maximum critical shear stress for slip + xi_slip_0, & !< initial critical shear stress for slip + xi_twin_0, & !< initial critical shear stress for twin + xi_slip_sat, & !< maximum critical shear stress for slip nonSchmidCoeff, & H_int, & !< per family hardening activity (optional) !ToDo: Better name! - shear_twin !< characteristic shear for twins + gamma_twin_char !< characteristic shear for twins real(pReal), dimension(:,:), allocatable :: & interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity @@ -82,10 +82,10 @@ module plastic_phenopowerlaw type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & - s_slip, & - s_twin, & - accshear_slip, & - accshear_twin, & + xi_slip, & + xi_twin, & + gamma_slip, & + gamma_twin, & whole real(pReal), pointer, dimension(:) :: & sumGamma, & @@ -158,7 +158,11 @@ subroutine plastic_phenopowerlaw_init real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - type(tParameters) :: prm + type(tParameters) :: & + prm + type(tPhenopowerlawState) :: & + stt, & + dot integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -186,7 +190,7 @@ subroutine plastic_phenopowerlaw_init do p = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle instance = phase_plasticityInstance(p) - associate(prm => param(instance)) + associate(prm => param(instance),stt => state(instance),dot => dotState(instance)) extmsg = '' prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) @@ -198,8 +202,8 @@ subroutine plastic_phenopowerlaw_init if (prm%totalNslip > 0_pInt) then ! reading in slip related parameters - prm%tau0_slip = config_phase(p)%getFloats('tau0_slip', requiredShape=shape(prm%Nslip)) - prm%tausat_slip = config_phase(p)%getFloats('tausat_slip', requiredShape=shape(prm%Nslip)) + prm%xi_slip_0 = config_phase(p)%getFloats('tau0_slip', requiredShape=shape(prm%Nslip)) + prm%xi_slip_sat = config_phase(p)%getFloats('tausat_slip', requiredShape=shape(prm%Nslip)) prm%interaction_SlipSlip = spread(config_phase(p)%getFloats('interaction_slipslip', & requiredShape=shape(prm%Nslip)),2,1) prm%H_int = config_phase(p)%getFloats('h_int', requiredShape=shape(prm%Nslip), & @@ -213,18 +217,18 @@ subroutine plastic_phenopowerlaw_init prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') ! sanity checks for slip related parameters - if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_slip " - if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tausat_slip " + if (any(prm%xi_slip_0 < 0.0_pReal .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"xi_slip_0 " + if (any(prm%xi_slip_sat < prm%xi_slip_0 .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"xi_slip_sat " if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_slip " if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//"a_slip " ! ToDo: negative values ok? if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//"n_slip " ! ToDo: negative values ok? ! expand slip related parameters from system => family - prm%tau0_slip = math_expand(prm%tausat_slip,prm%Nslip) - prm%tausat_slip = math_expand(prm%tausat_slip,prm%Nslip) + prm%xi_slip_0 = math_expand(prm%xi_slip_0,prm%Nslip) + prm%xi_slip_sat = math_expand(prm%xi_slip_sat,prm%Nslip) prm%H_int = math_expand(prm%H_int,prm%Nslip) endif @@ -237,7 +241,7 @@ subroutine plastic_phenopowerlaw_init if (prm%totalNtwin > 0_pInt) then ! reading in twin related parameters - prm%tau0_twin = config_phase(p)%getFloats('tau0_twin', requiredShape=shape(prm%Ntwin)) + prm%xi_twin_0 = config_phase(p)%getFloats('tau0_twin', requiredShape=shape(prm%Ntwin)) prm%interaction_TwinTwin = spread(config_phase(p)%getFloats('interaction_twintwin', & requiredShape=shape(prm%Ntwin)),2,1) @@ -247,13 +251,13 @@ subroutine plastic_phenopowerlaw_init prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') ! sanity checks for twin related parameters - if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_slip " + if (any(prm%xi_twin_0 < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & + extmsg = trim(extmsg)//"xi_twin_0 " if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? ! expand slip related parameters from system => family - prm%tau0_twin = math_expand(prm%tau0_twin,prm%Ntwin) + prm%xi_twin_0 = math_expand(prm%xi_twin_0,prm%Ntwin) endif if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then @@ -331,8 +335,8 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','accshear_slip']) * prm%TotalNslip & - + size(['tau_twin ','accshear_twin']) * prm%TotalNtwin & + sizeState = size(['tau_slip ','gamma_slip']) * prm%TotalNslip & + + size(['tau_twin ','gamma_twin']) * prm%TotalNtwin & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState @@ -402,19 +406,19 @@ subroutine plastic_phenopowerlaw_init enddo mySlipFamilies prm%interaction_SlipSlip = temp1; deallocate(temp1) prm%interaction_SlipTwin = temp2; deallocate(temp2) - + allocate(temp1(prm%totalNtwin,prm%totalNslip),source = 0.0_pReal) allocate(temp2(prm%totalNtwin,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) - allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal) + allocate(prm%gamma_twin_char(prm%totalNtwin),source = 0.0_pReal) i = 0_pInt myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) myTwinSystems: do j = 1_pInt,prm%Ntwin(f) i = i + 1_pInt prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,sum(lattice_NTwinsystem(1:f-1,p))+j,p) - prm%shear_twin(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p) + prm%gamma_twin_char(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p) slipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) slipSystems: do k = 1_pInt,prm%Nslip(o) @@ -443,34 +447,34 @@ subroutine plastic_phenopowerlaw_init ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt endIndex = prm%totalNslip - state (instance)%s_slip => plasticState(p)%state (startIndex:endIndex,:) - state (instance)%s_slip = spread(prm%tau0_slip, 2, NipcMyPhase) - dotState(instance)%s_slip => plasticState(p)%dotState(startIndex:endIndex,:) + stt%xi_slip => plasticState(p)%state (startIndex:endIndex,:) + stt%xi_slip = spread(prm%xi_slip_0, 2, NipcMyPhase) + dot%xi_slip => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + prm%totalNtwin - state (instance)%s_twin => plasticState(p)%state (startIndex:endIndex,:) - state (instance)%s_twin = spread(prm%tau0_twin, 2, NipcMyPhase) - dotState(instance)%s_twin => plasticState(p)%dotState(startIndex:endIndex,:) + stt%xi_twin => plasticState(p)%state (startIndex:endIndex,:) + stt%xi_twin = spread(prm%xi_twin_0, 2, NipcMyPhase) + dot%xi_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt - state (instance)%sumGamma => plasticState(p)%state (startIndex,:) - dotState(instance)%sumGamma => plasticState(p)%dotState(startIndex,:) + stt%sumGamma => plasticState(p)%state (startIndex,:) + dot%sumGamma => plasticState(p)%dotState(startIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt - state (instance)%sumF=>plasticState(p)%state (startIndex,:) - dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) + stt%sumF=>plasticState(p)%state (startIndex,:) + dot%sumF=>plasticState(p)%dotState(startIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac startIndex = endIndex + 1_pInt endIndex = endIndex + prm%totalNslip - state (instance)%accshear_slip => plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_slip => plasticState(p)%dotState(startIndex:endIndex,:) + stt%gamma_slip => plasticState(p)%state (startIndex:endIndex,:) + dot%gamma_slip => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear ! global alias plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) @@ -478,12 +482,12 @@ subroutine plastic_phenopowerlaw_init startIndex = endIndex + 1_pInt endIndex = endIndex + prm%totalNtwin - state (instance)%accshear_twin => plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_twin => plasticState(p)%dotState(startIndex:endIndex,:) + stt%gamma_twin => plasticState(p)%state (startIndex:endIndex,:) + dot%gamma_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - - dotState(instance)%whole => plasticState(p)%dotState - + + dot%whole => plasticState(p)%dotState + end associate enddo @@ -505,7 +509,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, implicit none real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & + real(pReal), dimension(9,9), intent(out) :: & dLp_dMstar99 !< derivative of Lp with respect to the Mandel stress integer(pInt), intent(in) :: & @@ -573,7 +577,7 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) use math, only: & - math_Mandel6to33 + math_Mandel6to33 use material, only: & material_phase, & phasememberAt, & @@ -593,7 +597,7 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & - ssat_offset + xi_slip_sat_offset real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress @@ -621,35 +625,35 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors left_SlipSlip = 1.0_pReal + prm%H_int - ssat_offset = prm%spr*sqrt(stt%sumF(of)) - right_SlipSlip = abs(1.0_pReal-stt%s_slip(:,of) / (prm%tausat_slip+ssat_offset)) **prm%a_slip & - * sign(1.0_pReal,1.0_pReal-stt%s_slip(:,of) / (prm%tausat_slip+ssat_offset)) + xi_slip_sat_offset = prm%spr*sqrt(stt%sumF(of)) + right_SlipSlip = abs(1.0_pReal-stt%xi_slip(:,of) / (prm%xi_slip_sat+xi_slip_sat_offset)) **prm%a_slip & + * sign(1.0_pReal,1.0_pReal-stt%xi_slip(:,of) / (prm%xi_slip_sat+xi_slip_sat_offset)) !-------------------------------------------------------------------------------------------------- ! shear rates call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg) - dot%accshear_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) - dot%sumGamma(of) = sum(dot%accshear_slip(:,of)) - call kinetics_twin(prm,stt,of,S,dot%accshear_twin(:,of)) - if (stt%sumF(of) < 0.98_pReal) dot%sumF(of) = sum(dot%accshear_twin(:,of)/prm%shear_twin) + dot%gamma_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) + dot%sumGamma(of) = sum(dot%gamma_slip(:,of)) + call kinetics_twin(prm,stt,of,S,dot%gamma_twin(:,of)) + if (stt%sumF(of) < 0.98_pReal) dot%sumF(of) = sum(dot%gamma_twin(:,of)/prm%gamma_twin_char) !-------------------------------------------------------------------------------------------------- ! hardening hardeningSlip: do i = 1_pInt, prm%totalNslip - dot%s_slip(i,of) = & + dot%xi_slip(i,of) = & c_SlipSlip * left_SlipSlip(i) & - * dot_product(prm%interaction_SlipSlip(i,:),right_SlipSlip*dot%accshear_slip(:,of)) & - + & - dot_product(prm%interaction_SlipTwin(i,:),dot%accshear_twin(:,of)) + * dot_product(prm%interaction_SlipSlip(i,:),right_SlipSlip*dot%gamma_slip(:,of)) & + + & + dot_product(prm%interaction_SlipTwin(i,:),dot%gamma_twin(:,of)) enddo hardeningSlip hardeningTwin: do i = 1_pInt, prm%totalNtwin - dot%s_twin(i,of) = & + dot%xi_twin(i,of) = & c_TwinSlip & - * dot_product(prm%interaction_TwinSlip(i,:),dot%accshear_slip(:,of)) & + * dot_product(prm%interaction_TwinSlip(i,:),dot%gamma_slip(:,of)) & + & c_TwinTwin & - * dot_product(prm%interaction_TwinTwin(i,:),dot%accshear_twin(:,of)) + * dot_product(prm%interaction_TwinTwin(i,:),dot%gamma_twin(:,of)) enddo hardeningTwin end associate @@ -659,7 +663,7 @@ end subroutine plastic_phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress -!> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the +!> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the !> result (i.e. intent(out)) variables are the last to have the optional arguments at the end !-------------------------------------------------------------------------------------------------- subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & @@ -701,18 +705,18 @@ subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & enddo gdot_slip_pos = 0.5_pReal*prm%gdot0_slip & - * sign(abs(tau_slip_pos/stt%s_slip(:,of))**prm%n_slip, tau_slip_pos) + * sign(abs(tau_slip_pos/stt%xi_slip(:,of))**prm%n_slip, tau_slip_pos) gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & - * sign(abs(tau_slip_neg/stt%s_slip(:,of))**prm%n_slip, tau_slip_neg) + * sign(abs(tau_slip_neg/stt%xi_slip(:,of))**prm%n_slip, tau_slip_neg) - if (present(dgdot_dtau_slip_pos)) then + if (present(dgdot_dtau_slip_pos)) then where(dNeq0(tau_slip_pos)) dgdot_dtau_slip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos else where dgdot_dtau_slip_pos = 0.0_pReal end where endif - if (present(dgdot_dtau_slip_neg)) then + if (present(dgdot_dtau_slip_neg)) then where(dNeq0(tau_slip_neg)) dgdot_dtau_slip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg else where @@ -725,7 +729,7 @@ end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on twin systems and derivatives with respect to resolved stress -!> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the +!> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the !> result (i.e. intent(out)) variables are the last to have the optional arguments at the end !-------------------------------------------------------------------------------------------------- subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) @@ -755,10 +759,10 @@ subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) do i = 1_pInt, prm%totalNtwin tau_twin(i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) enddo - gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%s_twin(:,of))**prm%n_twin, & + gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%xi_twin(:,of))**prm%n_twin, & 0.0_pReal, tau_twin>0.0_pReal) - if (present(dgdot_dtau_twin)) then + if (present(dgdot_dtau_twin)) then where(dNeq0(tau_twin)) dgdot_dtau_twin = gdot_twin*prm%n_twin/tau_twin else where @@ -780,7 +784,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) phase_plasticityInstance use math, only: & math_mul33xx33, & - math_Mandel6to33 + math_Mandel6to33 implicit none real(pReal), dimension(6), intent(in) :: & @@ -788,7 +792,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point - el !< element !< microstructure state + el !< element real(pReal), dimension(3,3) :: & S !< Second-Piola Kirchhoff stress @@ -818,10 +822,10 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) select case(prm%outputID(o)) case (resistance_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%s_slip(1:prm%totalNslip,of) + postResults(c+1_pInt:c+prm%totalNslip) = stt%xi_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (accumulatedshear_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) + postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (shearrate_slip_ID) call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg) @@ -840,10 +844,10 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) c = c + prm%totalNslip case (resistance_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%s_twin(1:prm%totalNtwin,of) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%xi_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (accumulatedshear_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1:prm%totalNtwin,of) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (shearrate_twin_ID) call kinetics_twin(prm,stt,of,S,postResults(c+1_pInt:c+prm%totalNtwin)) From 25a38ad438423d8286281dfd363b7d84a8b8ed4b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Sep 2018 05:45:10 +0200 Subject: [PATCH 38/41] initialization broken - need to consider case of no twin/slip active - state0 needs to be initialized --- src/plastic_phenopowerlaw.f90 | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 993b41ad9..5e3c8a2ee 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -131,7 +131,7 @@ subroutine plastic_phenopowerlaw_init phase_plasticity, & phase_plasticityInstance, & phase_Noutput, & - PLASTICITY_PHENOPOWERLAW_label, & + PLASTICITY_PHENOPOWERLAW_LABEL, & PLASTICITY_PHENOPOWERLAW_ID, & material_phase, & plasticState @@ -200,7 +200,7 @@ subroutine plastic_phenopowerlaw_init if (any(lattice_NslipSystem(1:size(prm%Nslip),p)-prm%Nslip < 0_pInt)) & call IO_error(150_pInt,ext_msg='Nslip') - if (prm%totalNslip > 0_pInt) then + slipActive: if (prm%totalNslip > 0_pInt) then ! reading in slip related parameters prm%xi_slip_0 = config_phase(p)%getFloats('tau0_slip', requiredShape=shape(prm%Nslip)) prm%xi_slip_sat = config_phase(p)%getFloats('tausat_slip', requiredShape=shape(prm%Nslip)) @@ -230,7 +230,9 @@ subroutine plastic_phenopowerlaw_init prm%xi_slip_0 = math_expand(prm%xi_slip_0,prm%Nslip) prm%xi_slip_sat = math_expand(prm%xi_slip_sat,prm%Nslip) prm%H_int = math_expand(prm%H_int,prm%Nslip) - endif + else slipActive + allocate(prm%xi_slip_0(0)) + endif slipActive prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) prm%totalNtwin = sum(prm%Ntwin) @@ -239,11 +241,11 @@ subroutine plastic_phenopowerlaw_init if (any(lattice_NtwinSystem(1:size(prm%Ntwin),p)-prm%Ntwin < 0_pInt)) & call IO_error(150_pInt,ext_msg='Ntwin') - if (prm%totalNtwin > 0_pInt) then + twinActive: if (prm%totalNtwin > 0_pInt) then ! reading in twin related parameters - prm%xi_twin_0 = config_phase(p)%getFloats('tau0_twin', requiredShape=shape(prm%Ntwin)) + prm%xi_twin_0 = config_phase(p)%getFloats('tau0_twin',requiredShape=shape(prm%Ntwin)) prm%interaction_TwinTwin = spread(config_phase(p)%getFloats('interaction_twintwin', & - requiredShape=shape(prm%Ntwin)),2,1) + requiredShape=shape(prm%Ntwin)),2,1) prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') prm%n_twin = config_phase(p)%getFloat('n_twin') @@ -258,15 +260,17 @@ subroutine plastic_phenopowerlaw_init ! expand slip related parameters from system => family prm%xi_twin_0 = math_expand(prm%xi_twin_0,prm%Ntwin) - endif + else twinActive + allocate(prm%xi_twin_0(0)) + endif twinActive - if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then + slipAndTwinActive: if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = spread(config_phase(p)%getFloats('interaction_sliptwin'),2,1) prm%interaction_TwinSlip = spread(config_phase(p)%getFloats('interaction_twinslip'),2,1) prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') - else + else slipAndTwinActive prm%h0_TwinSlip = 0.0_pReal - endif + endif slipAndTwinActive ! optional parameters that should be defined prm%twinB = config_phase(p)%getFloat('twin_b',defaultVal=1.0_pReal) @@ -486,6 +490,7 @@ subroutine plastic_phenopowerlaw_init dot%gamma_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + plasticState(p)%state0 = plasticState(p)%state dot%whole => plasticState(p)%dotState end associate From 9570fb894ae8a371b8d7c55d3ad106fc918181d2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 16 Sep 2018 22:16:06 +0200 Subject: [PATCH 39/41] correct names and no superflous conversions anymore --- src/constitutive.f90 | 32 ++++++++----- src/plastic_phenopowerlaw.f90 | 88 +++++++++++++++-------------------- 2 files changed, 57 insertions(+), 63 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index dba1463a7..0c40b0dd7 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -440,7 +440,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e math_Mandel33to6, & math_Plain99to3333 use material, only: & + phasememberAt, & phase_plasticity, & + phase_plasticityInstance, & material_phase, & material_homog, & temperature, & @@ -490,7 +492,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e ho, & !< homogenization tme !< thermal member position integer(pInt) :: & - i, j + i, j, instance, of ho = material_homog(ip,el) tme = thermalMapping(ho)%p(ip,el) @@ -509,8 +511,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el) - dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp, Mp,ipc,ip,el) case (PLASTICITY_KINEHARDENING_ID) plasticityType call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el) @@ -825,6 +828,8 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac mesh_NcpElems, & mesh_maxNips use material, only: & + phasememberAt, & + phase_plasticityInstance, & phase_plasticity, & phase_source, & phase_Nsources, & @@ -882,38 +887,41 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac real(pReal), intent(in), dimension(6) :: & S6 !< 2nd Piola Kirchhoff stress (vector notation) real(pReal), dimension(3,3) :: & - Mstar + Mp integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position - s !< counter in source loop + s, & !< counter in source loop + instance, of ho = material_homog( ip,el) tme = thermalMapping(ho)%p(ip,el) - Mstar = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_dotState (math_Mandel33to6(Mstar),ipc,ip,el) + call plastic_isotropic_dotState (math_Mandel33to6(Mp),ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_dotState(math_Mandel33to6(Mstar),ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_phenopowerlaw_dotState(Mp,ipc,ip,el) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_dotState(math_Mandel33to6(Mstar),ipc,ip,el) + call plastic_kinehardening_dotState(math_Mandel33to6(Mp),ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_dotState (math_Mandel33to6(Mstar),temperature(ho)%p(tme), & + call plastic_dislotwin_dotState (math_Mandel33to6(Mp),temperature(ho)%p(tme), & ipc,ip,el) case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_dotState (math_Mandel33to6(Mstar),temperature(ho)%p(tme), & + call plastic_disloucla_dotState (math_Mandel33to6(Mp),temperature(ho)%p(tme), & ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState (math_Mandel33to6(Mstar),FeArray,FpArray,temperature(ho)%p(tme), & + call plastic_nonlocal_dotState (math_Mandel33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), & subdt,subfracArray,ip,el) end select plasticityType diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 5e3c8a2ee..da3acd439 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -502,10 +502,7 @@ end subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip,el) - use math, only: & - math_Mandel6to33, & - math_Plain3333to99 +subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ipc,ip,el) use material, only: & phasememberAt, & material_phase, & @@ -514,23 +511,19 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, implicit none real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dMstar99 !< derivative of Lp with respect to the Mandel stress + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp !< derivative of Lp with respect to the Mandel stress integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), dimension(6), intent(in) :: & - Mstar_v !< Mandel stress + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress integer(pInt) :: & i,k,l,m,n, & of - real(pReal), dimension(3,3) :: & - S !< Second-Piola Kirchhoff stress - real(pReal), dimension(3,3,3,3) :: & - dLp_dS !< derivative of Lp with respect to Mstar as 4th order tensor real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & dgdot_dtauslip_pos,dgdot_dtauslip_neg, & gdot_slip_pos,gdot_slip_neg @@ -542,37 +535,35 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar99,Mstar_v,ipc,ip, ! BEGIN DEPRECATED of = phasememberAt(ipc,ip,el) - S = math_Mandel6to33(Mstar_v) associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) ! END DEPRECATED Lp = 0.0_pReal - dLp_dS = 0.0_pReal + dLp_dMp = 0.0_pReal - call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) + call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) slipSystems: do i = 1_pInt, prm%totalNslip Lp = Lp + (1.0_pReal-stt%sumF(of))*(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_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtauslip_pos(i) * prm%Schmid_slip(k,l,i) & - *(prm%Schmid_slip(m,n,i) + sum(prm%nonSchmid_pos(m,n,:,i))) + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + dgdot_dtauslip_pos(i) * prm%Schmid_slip(k,l,i) & + *(prm%Schmid_slip(m,n,i) + sum(prm%nonSchmid_pos(m,n,:,i))) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) & - *(prm%Schmid_slip(m,n,i) + sum(prm%nonSchmid_neg(m,n,:,i))) + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) & + *(prm%Schmid_slip(m,n,i) + sum(prm%nonSchmid_neg(m,n,:,i))) enddo slipSystems - call kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtautwin) + call kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtautwin) twinSystems: do i = 1_pInt, prm%totalNtwin Lp = Lp + gdot_twin(i)*prm%Schmid_twin(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_dS(k,l,m,n) = dLp_dS(k,l,m,n) & - + dgdot_dtautwin(i)*prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + dgdot_dtautwin(i)*prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) enddo twinSystems end associate - dLp_dMstar99 = math_Plain3333to99(dLp_dS) ! DEPRECATED end subroutine plastic_phenopowerlaw_LpAndItsTangent @@ -580,17 +571,15 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) - use math, only: & - math_Mandel6to33 +subroutine plastic_phenopowerlaw_dotState(Mp,ipc,ip,el) use material, only: & material_phase, & phasememberAt, & phase_plasticityInstance implicit none - real(pReal), dimension(6), intent(in) :: & - Mstar6 !< Mandel stress + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point @@ -604,8 +593,6 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) c_SlipSlip,c_TwinSlip,c_TwinTwin, & xi_slip_sat_offset - real(pReal), dimension(3,3) :: & - S !< Second-Piola Kirchhoff stress real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & left_SlipSlip,right_SlipSlip, & gdot_slip_pos,gdot_slip_neg @@ -619,7 +606,6 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) dot => dotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) dot%whole(:,of) = 0.0_pReal - S = math_Mandel6to33(Mstar6) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -636,10 +622,10 @@ subroutine plastic_phenopowerlaw_dotState(Mstar6,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! shear rates - call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg) + call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg) dot%gamma_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) dot%sumGamma(of) = sum(dot%gamma_slip(:,of)) - call kinetics_twin(prm,stt,of,S,dot%gamma_twin(:,of)) + call kinetics_twin(prm,stt,of,Mp,dot%gamma_twin(:,of)) if (stt%sumF(of) < 0.98_pReal) dot%sumF(of) = sum(dot%gamma_twin(:,of)/prm%gamma_twin_char) !-------------------------------------------------------------------------------------------------- @@ -671,7 +657,7 @@ end subroutine plastic_phenopowerlaw_dotState !> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the !> result (i.e. intent(out)) variables are the last to have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & +subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, & dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) use prec, only: & dNeq0 @@ -692,7 +678,7 @@ subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & dgdot_dtau_slip_pos, & dgdot_dtau_slip_neg real(pReal), dimension(3,3), intent(in) :: & - S + Mp real(pReal), dimension(prm%totalNslip) :: & tau_slip_pos, & @@ -701,11 +687,11 @@ subroutine kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg, & integer(pInt) :: i, j do i = 1_pInt, prm%totalNslip - tau_slip_pos(i) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,i)) + tau_slip_pos(i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) tau_slip_neg(i) = tau_slip_pos(i) do j = 1,size(prm%nonSchmidCoeff) - tau_slip_pos(i) = tau_slip_pos(i) + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,j,i)) - tau_slip_neg(i) = tau_slip_neg(i) + math_mul33xx33(S,prm%nonSchmid_neg(1:3,1:3,j,i)) + tau_slip_pos(i) = tau_slip_pos(i) + math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j,i)) + tau_slip_neg(i) = tau_slip_neg(i) + math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j,i)) enddo enddo @@ -737,7 +723,7 @@ end subroutine kinetics_slip !> @details: Shear rates are calculated only optionally. NOTE: Agains the common convention, the !> result (i.e. intent(out)) variables are the last to have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) +subroutine kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtau_twin) use prec, only: & dNeq0 use math, only: & @@ -751,7 +737,7 @@ subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) integer(pInt), intent(in) :: & of real(pReal), dimension(3,3), intent(in) :: & - S + Mp real(pReal), dimension(prm%totalNtwin), intent(out) :: & gdot_twin real(pReal), dimension(prm%totalNtwin), optional, intent(out) :: & @@ -762,7 +748,7 @@ subroutine kinetics_twin(prm,stt,of,S,gdot_twin,dgdot_dtau_twin) integer(pInt) :: i do i = 1_pInt, prm%totalNtwin - tau_twin(i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) + tau_twin(i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) enddo gdot_twin = merge((1.0_pReal-stt%sumF(of))*prm%gdot0_twin*(abs(tau_twin)/stt%xi_twin(:,of))**prm%n_twin, & 0.0_pReal, tau_twin>0.0_pReal) @@ -781,7 +767,7 @@ end subroutine kinetics_twin !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) +function plastic_phenopowerlaw_postResults(Mp6,ipc,ip,el) result(postResults) use material, only: & material_phase, & plasticState, & @@ -793,14 +779,14 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) implicit none real(pReal), dimension(6), intent(in) :: & - Mstar6 !< Mandel stress + Mp6 !< Mandel stress integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), dimension(3,3) :: & - S !< Second-Piola Kirchhoff stress + Mp !< Second-Piola Kirchhoff stress real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & postResults @@ -821,7 +807,7 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) postResults = 0.0_pReal c = 0_pInt - S = math_Mandel6to33(Mstar6) !DEPRECATED + Mp = math_Mandel6to33(Mp6) !DEPRECATED outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) @@ -833,12 +819,12 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (shearrate_slip_ID) - call kinetics_slip(prm,stt,of,S,gdot_slip_pos,gdot_slip_neg) + call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg) postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg c = c + prm%totalNslip case (resolvedstress_slip_ID) do i = 1_pInt, prm%totalNslip - tau_slip_pos = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,i)) + tau_slip_pos = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) tau_slip_neg = tau_slip_pos !do j = 1,size(prm%nonSchmidCoeff) ! tau_slip_pos = tau_slip_pos + math_mul33xx33(S,prm%nonSchmid_pos(1:3,1:3,j,i)) @@ -855,11 +841,11 @@ function plastic_phenopowerlaw_postResults(Mstar6,ipc,ip,el) result(postResults) postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (shearrate_twin_ID) - call kinetics_twin(prm,stt,of,S,postResults(c+1_pInt:c+prm%totalNtwin)) + call kinetics_twin(prm,stt,of,Mp,postResults(c+1_pInt:c+prm%totalNtwin)) c = c + prm%totalNtwin case (resolvedstress_twin_ID) do i = 1_pInt, prm%totalNtwin - postResults(c+i) = math_mul33xx33(S,prm%Schmid_twin(1:3,1:3,i)) + postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) enddo c = c + prm%totalNtwin From cea2fba0638489cdbf40430f6047dcbb0d8c48f9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 16 Sep 2018 22:38:57 +0200 Subject: [PATCH 40/41] don't repeat code that can be handled centrally --- src/plastic_phenopowerlaw.f90 | 48 ++++++++++------------------------- 1 file changed, 14 insertions(+), 34 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index da3acd439..9f32382b9 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -502,11 +502,7 @@ end subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ipc,ip,el) - use material, only: & - phasememberAt, & - material_phase, & - phase_plasticityInstance +subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) implicit none real(pReal), dimension(3,3), intent(out) :: & @@ -514,30 +510,24 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ipc,ip,el) real(pReal), dimension(3,3,3,3), intent(out) :: & dLp_dMp !< derivative of Lp with respect to the Mandel stress - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of integer(pInt) :: & - i,k,l,m,n, & - of - real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + i,k,l,m,n + real(pReal), dimension(param(instance)%totalNslip) :: & dgdot_dtauslip_pos,dgdot_dtauslip_neg, & gdot_slip_pos,gdot_slip_neg - real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & + real(pReal), dimension(param(instance)%totalNtwin) :: & gdot_twin,dgdot_dtautwin type(tParameters) :: prm type(tPhenopowerlawState) :: stt -! BEGIN DEPRECATED - of = phasememberAt(ipc,ip,el) - associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& - stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) -! END DEPRECATED + associate(prm => param(instance), stt => state(instance)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal @@ -571,39 +561,29 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_dotState(Mp,ipc,ip,el) - use material, only: & - material_phase, & - phasememberAt, & - phase_plasticityInstance +subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element !< microstructure state + instance, & + of integer(pInt) :: & - ph, & - i,k, & - of + i,k real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & xi_slip_sat_offset - real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + real(pReal), dimension(param(instance)%totalNslip) :: & left_SlipSlip,right_SlipSlip, & gdot_slip_pos,gdot_slip_neg type(tParameters) :: prm type(tPhenopowerlawState) :: dot,stt - of = phasememberAt(ipc,ip,el) - associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & - stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))), & - dot => dotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) + associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) dot%whole(:,of) = 0.0_pReal From e6fa3f3d35edf380fa79388eafca6a8921769a1d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 16 Sep 2018 22:57:50 +0200 Subject: [PATCH 41/41] correct stress in postResults --- src/constitutive.f90 | 29 ++++++++++++++++++++++------- src/crystallite.f90 | 4 ++-- src/plastic_phenopowerlaw.f90 | 23 ++++++++--------------- 3 files changed, 32 insertions(+), 24 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 0c40b0dd7..eedc3e509 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -513,7 +513,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp, Mp,ipc,ip,el) + call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el) @@ -821,6 +821,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac debug_constitutive, & debug_levelBasic use math, only: & + math_mul33x33, & math_Mandel6to33, & math_Mandel33to6, & math_mul33x33 @@ -907,7 +908,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - call plastic_phenopowerlaw_dotState(Mp,ipc,ip,el) + call plastic_phenopowerlaw_dotState(Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType call plastic_kinehardening_dotState(math_Mandel33to6(Mp),ipc,ip,el) @@ -1035,13 +1036,18 @@ end subroutine constitutive_collectDeltaState !-------------------------------------------------------------------------------------------------- !> @brief returns array of constitutive results !-------------------------------------------------------------------------------------------------- -function constitutive_postResults(S6, FeArray, ipc, ip, el) +function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) use prec, only: & pReal + use math, only: & + math_Mandel6to33, & + math_mul33x33 use mesh, only: & mesh_NcpElems, & mesh_maxNips use material, only: & + phasememberAt, & + phase_plasticityInstance, & plasticState, & sourceState, & phase_plasticity, & @@ -1092,19 +1098,25 @@ function constitutive_postResults(S6, FeArray, ipc, ip, el) real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults + & sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: & constitutive_postResults + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & FeArray !< elastic deformation gradient real(pReal), intent(in), dimension(6) :: & S6 !< 2nd Piola Kirchhoff stress (vector notation) + real(pReal), dimension(3,3) :: & + Mp !< Mandel stress integer(pInt) :: & startPos, endPos integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position - s !< counter in source loop + s, of, instance !< counter in source loop constitutive_postResults = 0.0_pReal + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + ho = material_homog( ip,el) tme = thermalMapping(ho)%p(ip,el) @@ -1113,10 +1125,13 @@ function constitutive_postResults(S6, FeArray, ipc, ip, el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType - constitutive_postResults(startPos:endPos) = plastic_isotropic_postResults(S6,ipc,ip,el) - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType constitutive_postResults(startPos:endPos) = & - plastic_phenopowerlaw_postResults(S6,ipc,ip,el) + plastic_isotropic_postResults(S6,ipc,ip,el) + case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + constitutive_postResults(startPos:endPos) = & + plastic_phenopowerlaw_postResults(Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_kinehardening_postResults(S6,ipc,ip,el) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 94ba805e8..f4a511338 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -3887,8 +3887,8 @@ function crystallite_postResults(ipc, ip, el) c = c + 1_pInt if (size(crystallite_postResults)-c > 0_pInt) & crystallite_postResults(c+1:size(crystallite_postResults)) = & - constitutive_postResults(crystallite_Tstar_v(1:6,ipc,ip,el), crystallite_Fe, & - ipc, ip, el) + constitutive_postResults(crystallite_Tstar_v(1:6,ipc,ip,el), crystallite_Fi(1:3,1:3,ipc,ip,el), & + crystallite_Fe, ipc, ip, el) end function crystallite_postResults diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 9f32382b9..f7c723521 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -747,7 +747,7 @@ end subroutine kinetics_twin !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_phenopowerlaw_postResults(Mp6,ipc,ip,el) result(postResults) +function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults) use material, only: & material_phase, & plasticState, & @@ -758,36 +758,29 @@ function plastic_phenopowerlaw_postResults(Mp6,ipc,ip,el) result(postResults) math_Mandel6to33 implicit none - real(pReal), dimension(6), intent(in) :: & - Mp6 !< Mandel stress + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + instance, & + of - real(pReal), dimension(3,3) :: & - Mp !< Second-Piola Kirchhoff stress - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & + real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: & postResults integer(pInt) :: & - of, & o,c,i,j real(pReal) :: & tau_slip_pos, tau_slip_neg - real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip_pos,gdot_slip_neg type(tParameters) :: prm type(tPhenopowerlawState) :: stt - of = phasememberAt(ipc,ip,el) - associate( prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))), & - stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))) ) + associate( prm => param(instance), stt => state(instance)) postResults = 0.0_pReal c = 0_pInt - Mp = math_Mandel6to33(Mp6) !DEPRECATED outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o))