From 5cf2973715fce14e5586e63037deacb75cd13fae Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 14:53:40 +0200 Subject: [PATCH 01/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] [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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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/65] 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)) From 20f0bee459f35f706ac21ae1470f5673576fbd24 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 19 Sep 2018 06:19:40 +0200 Subject: [PATCH 42/65] fallback dPdF not needed save a lot of memory --- src/crystallite.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 94ba805e8..af39fd572 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -71,8 +71,6 @@ module crystallite crystallite_dPdF, & !< current individual dPdF per grain (end of converged time step) crystallite_dPdF0, & !< individual dPdF per grain at start of FE inc crystallite_partioneddPdF0 !< individual dPdF per grain at start of homog inc - real(pReal), dimension(:,:,:,:,:,:,:), allocatable, private :: & - crystallite_fallbackdPdF !< dPdF fallback for non-converged grains (elastic prediction) logical, dimension(:,:,:), allocatable, public :: & crystallite_requested !< flag to request crystallite calculation logical, dimension(:,:,:), allocatable, public, protected :: & @@ -247,7 +245,6 @@ subroutine crystallite_init allocate(crystallite_dPdF(3,3,3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_dPdF0(3,3,3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_partioneddPdF0(3,3,3,3,cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_fallbackdPdF(3,3,3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_dt(cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_subdt(cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_subFrac(cMax,iMax,eMax), source=0.0_pReal) @@ -454,7 +451,6 @@ subroutine crystallite_init ! enddo call crystallite_stressAndItsTangent(.true.) ! request elastic answers - crystallite_fallbackdPdF = crystallite_dPdF ! use initial elastic stiffness as fallback !-------------------------------------------------------------------------------------------------- ! debug output @@ -490,7 +486,6 @@ subroutine crystallite_init write(6,'(a35,1x,7(i8,1x))') 'crystallite_dPdF: ', shape(crystallite_dPdF) write(6,'(a35,1x,7(i8,1x))') 'crystallite_dPdF0: ', shape(crystallite_dPdF0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_partioneddPdF0: ', shape(crystallite_partioneddPdF0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_fallbackdPdF: ', shape(crystallite_fallbackdPdF) write(6,'(a35,1x,7(i8,1x))') 'crystallite_orientation: ', shape(crystallite_orientation) write(6,'(a35,1x,7(i8,1x))') 'crystallite_orientation0: ', shape(crystallite_orientation0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_rotation: ', shape(crystallite_rotation) From 431065e8928210b2568c5a176bf93177e2edcb74 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 19 Sep 2018 10:22:02 +0200 Subject: [PATCH 43/65] [skip ci] updated version information after successful test of v2.0.2-560-g20f0bee4 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 429ed3632..cca202405 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-558-gdfba3c9b +v2.0.2-560-g20f0bee4 From a8fb7d7adeaade3293da111c5eb88a049d127e22 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 19 Sep 2018 14:21:10 +0200 Subject: [PATCH 44/65] not needed but I'm under the impression that the compiler removes such things anyway --- src/crystallite.f90 | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index af39fd572..d341f3653 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -57,7 +57,6 @@ module crystallite crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_P !< 1st Piola-Kirchhoff stress per grain real(pReal), dimension(:,:,:,:,:), allocatable, private :: & - crystallite_subFe0,& !< "elastic" def grad at start of crystallite inc crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc crystallite_invFi, & !< inverse of current intermediate def grad (end of converged time step) @@ -233,7 +232,6 @@ subroutine crystallite_init allocate(crystallite_Fi(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_invFi(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_Fe(3,3,cMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_subFe0(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_Lp0(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_partionedLp0(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_subLp0(3,3,cMax,iMax,eMax), source=0.0_pReal) @@ -473,7 +471,6 @@ subroutine crystallite_init write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedLi0: ', shape(crystallite_partionedLi0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF: ', shape(crystallite_subF) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF0: ', shape(crystallite_subF0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFe0: ', shape(crystallite_subFe0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFp0: ', shape(crystallite_subFp0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFi0: ', shape(crystallite_subFi0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subLp0: ', shape(crystallite_subLp0) @@ -651,9 +648,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_dPdF0(1:3,1:3,1:3,1:3,c,i,e) = crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,c,i,e) ! ...stiffness crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partionedF0(1:3,1:3,c,i,e) ! ...def grad crystallite_subTstar0_v(1:6,c,i,e) = crystallite_partionedTstar0_v(1:6,c,i,e) !...2nd PK stress - crystallite_subFe0(1:3,1:3,c,i,e) = math_mul33x33(math_mul33x33(crystallite_subF0(1:3,1:3,c,i,e), & - math_inv33(crystallite_subFp0(1:3,1:3,c,i,e))), & - math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)))! only needed later on for stiffness calculation crystallite_subFrac(c,i,e) = 0.0_pReal crystallite_subStep(c,i,e) = 1.0_pReal/subStepSizeCryst crystallite_todo(c,i,e) = .true. @@ -915,9 +909,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_subLi0(1:3,1:3,c,i,e) = crystallite_Li(1:3,1:3,c,i,e) ! ...intermediate velocity gradient crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp(1:3,1:3,c,i,e) ! ...plastic def grad crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi(1:3,1:3,c,i,e) ! ...intermediate def grad - crystallite_subFe0(1:3,1:3,c,i,e) = math_mul33x33(math_mul33x33(crystallite_subF (1:3,1:3,c,i,e), & - crystallite_invFp(1:3,1:3,c,i,e)), & - crystallite_invFi(1:3,1:3,c,i,e)) ! only needed later on for stiffness calculation !if abbrevation, make c and p private in omp plasticState (phaseAt(c,i,e))%subState0(:,phasememberAt(c,i,e)) = & plasticState (phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) From 0bf64645a1a4329a990e37695a732432192a78bd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 19 Sep 2018 14:22:35 +0200 Subject: [PATCH 45/65] should be done by the plasticity laws (for the moment) --- src/crystallite.f90 | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d341f3653..1c77037ad 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -435,19 +435,6 @@ subroutine crystallite_init enddo !$OMP END PARALLEL DO -!-------------------------------------------------------------------------------------------------- -! propagate dependent states to materialpoint and boundary value problem level -! do ph = 1_pInt,material_Nphase -! plasticState(ph)%partionedState0(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & -! plasticState(ph)%sizeState,:) & -! = plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & -! plasticState(ph)%sizeState,:) -! plasticState(ph)%state0 (plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & -! plasticState(ph)%sizeState,:) & -! = plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & -! plasticState(ph)%sizeState,:) -! enddo - call crystallite_stressAndItsTangent(.true.) ! request elastic answers !-------------------------------------------------------------------------------------------------- From c313dc1675b235e137b6a342f9b3ae949cbe0751 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 19 Sep 2018 17:04:12 +0200 Subject: [PATCH 46/65] only read access --- src/crystallite.f90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 1c77037ad..3bad73b4d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -38,6 +38,9 @@ module crystallite crystallite_orientation, & !< orientation as quaternion crystallite_orientation0, & !< initial orientation as quaternion crystallite_rotation !< grain rotation away from initial orientation as axis-angle (in degrees) in crystal reference frame + real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & + crystallite_Fe, & !< current "elastic" def grad (end of converged time step) + crystallite_P !< 1st Piola-Kirchhoff stress per grain real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_Fp, & !< current plastic def grad (end of converged time step) crystallite_Fp0, & !< plastic def grad at start of FE inc @@ -50,12 +53,10 @@ module crystallite crystallite_partionedF0, & !< def grad at start of homog inc crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc - crystallite_partionedLp0,& !< plastic velocity grad at start of homog inc + crystallite_partionedLp0, & !< plastic velocity grad at start of homog inc crystallite_Li, & !< current intermediate velocitiy grad (end of converged time step) crystallite_Li0, & !< intermediate velocitiy grad at start of FE inc - crystallite_partionedLi0,& !< intermediate velocity grad at start of homog inc - crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - crystallite_P !< 1st Piola-Kirchhoff stress per grain + crystallite_partionedLi0 !< intermediate velocity grad at start of homog inc real(pReal), dimension(:,:,:,:,:), allocatable, private :: & crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc From 11d4c28d885150d0f054f11a631e7dbabd23fc94 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 19 Sep 2018 19:45:57 +0200 Subject: [PATCH 47/65] flushes not needed + further cleaning --- src/crystallite.f90 | 57 +++++++++++---------------------------------- 1 file changed, 13 insertions(+), 44 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3bad73b4d..f28c7cb00 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -422,11 +422,10 @@ subroutine crystallite_init call crystallite_orientations() crystallite_orientation0 = crystallite_orientation ! store initial orientations for calculation of grain rotations - !$OMP PARALLEL DO PRIVATE(myNcomponents) + !$OMP PARALLEL DO do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNcomponents = homogenization_Ngrains(mesh_element(3,e)) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do c = 1_pInt,myNcomponents + do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) call constitutive_microstructure(crystallite_orientation, & ! pass orientation to constitutive module crystallite_Fe(1:3,1:3,c,i,e), & crystallite_Fp(1:3,1:3,c,i,e), & @@ -574,7 +573,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) neighboring_i, & o, & p, & - myNcomponents, & mySource ! local variables used for calculating analytic Jacobian real(pReal), dimension(3,3) :: temp_33 @@ -617,10 +615,9 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! initialize to starting condition crystallite_subStep = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(myNcomponents) + !$OMP PARALLEL DO elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNcomponents = homogenization_Ngrains(mesh_element(3,e)) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1_pInt,myNcomponents + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_requested(c,i,e)) then plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = & plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e)) @@ -876,23 +873,20 @@ subroutine crystallite_stressAndItsTangent(updateJaco) endif timeSyncing1 - !$OMP PARALLEL DO PRIVATE(myNcomponents,formerSubStep) + !$OMP PARALLEL DO PRIVATE(formerSubStep) elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNcomponents = homogenization_Ngrains(mesh_element(3,e)) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed - do c = 1,myNcomponents + do c = 1,homogenization_Ngrains(mesh_element(3,e)) ! --- wind forward --- if (crystallite_converged(c,i,e) .and. crystallite_clearToWindForward(i,e)) then formerSubStep = crystallite_subStep(c,i,e) crystallite_subFrac(c,i,e) = crystallite_subFrac(c,i,e) + crystallite_subStep(c,i,e) - !$OMP FLUSH(crystallite_subFrac) crystallite_subStep(c,i,e) = min(1.0_pReal - crystallite_subFrac(c,i,e), & stepIncreaseCryst * crystallite_subStep(c,i,e)) - !$OMP FLUSH(crystallite_subStep) + if (crystallite_subStep(c,i,e) > 0.0_pReal) then crystallite_subF0(1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) ! ...def grad - !$OMP FLUSH(crystallite_subF0) crystallite_subLp0(1:3,1:3,c,i,e) = crystallite_Lp(1:3,1:3,c,i,e) ! ...plastic velocity gradient crystallite_subLi0(1:3,1:3,c,i,e) = crystallite_Li(1:3,1:3,c,i,e) ! ...intermediate velocity gradient crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp(1:3,1:3,c,i,e) ! ...plastic def grad @@ -912,7 +906,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) else crystallite_todo(c,i,e) = .true. endif - !$OMP FLUSH(crystallite_todo) #ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) & @@ -923,7 +916,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) #endif else ! this crystallite just converged for the entire timestep crystallite_todo(c,i,e) = .false. ! so done here - !$OMP FLUSH(crystallite_todo) endif ! --- cutback --- @@ -934,15 +926,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) else crystallite_subStep(c,i,e) = subStepSizeCryst * crystallite_subStep(c,i,e) ! cut step in half and restore... endif - !$OMP FLUSH(crystallite_subStep) crystallite_Fp(1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e) ! ...plastic def grad - !$OMP FLUSH(crystallite_Fp) crystallite_invFp(1:3,1:3,c,i,e) = math_inv33(crystallite_Fp(1:3,1:3,c,i,e)) - !$OMP FLUSH(crystallite_invFp) crystallite_Fi(1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e) ! ...intermediate def grad - !$OMP FLUSH(crystallite_Fi) crystallite_invFi(1:3,1:3,c,i,e) = math_inv33(crystallite_Fi(1:3,1:3,c,i,e)) - !$OMP FLUSH(crystallite_invFi) crystallite_Lp(1:3,1:3,c,i,e) = crystallite_subLp0(1:3,1:3,c,i,e) ! ...plastic velocity grad crystallite_Li(1:3,1:3,c,i,e) = crystallite_subLi0(1:3,1:3,c,i,e) ! ...intermediate velocity grad plasticState (phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) = & @@ -955,7 +942,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! cant restore dotState here, since not yet calculated in first cutback after initialization crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst ! still on track or already done (beyond repair) - !$OMP FLUSH(crystallite_todo) #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) & @@ -976,10 +962,8 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (crystallite_todo(c,i,e) .and. (crystallite_clearToWindForward(i,e) .or. crystallite_clearToCutback(i,e))) then crystallite_subF(1:3,1:3,c,i,e) = crystallite_subF0(1:3,1:3,c,i,e) & - + crystallite_subStep(c,i,e) & - * (crystallite_partionedF(1:3,1:3,c,i,e) & + + crystallite_subStep(c,i,e) * (crystallite_partionedF(1:3,1:3,c,i,e) & - crystallite_partionedF0(1:3,1:3,c,i,e)) - !$OMP FLUSH(crystallite_subF) crystallite_Fe(1:3,1:3,c,i,e) = math_mul33x33(math_mul33x33(crystallite_subF (1:3,1:3,c,i,e), & crystallite_invFp(1:3,1:3,c,i,e)), & crystallite_invFi(1:3,1:3,c,i,e)) @@ -997,9 +981,8 @@ subroutine crystallite_stressAndItsTangent(updateJaco) .and. crystallite_subStep <= subStepMinCryst)) then ! no way of rescuing a nonlocal ip that violated the lower time step limit, ... if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNcomponents = homogenization_Ngrains(mesh_element(3,e)) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do c = 1,myNcomponents + do c = 1,homogenization_Ngrains(mesh_element(3,e)) if (.not. crystallite_localPlasticity(c,i,e) .and. .not. crystallite_todo(c,i,e) & .and. .not. crystallite_converged(c,i,e) .and. crystallite_subStep(c,i,e) <= subStepMinCryst) & write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> nonlocal violated minimum subStep at el ip ipc ',e,i,c @@ -1041,9 +1024,8 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! --+>> CHECK FOR NON-CONVERGED CRYSTALLITES <<+-- elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNcomponents = homogenization_Ngrains(mesh_element(3,e)) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed - do c = 1,myNcomponents + do c = 1,homogenization_Ngrains(mesh_element(3,e)) if (.not. crystallite_converged(c,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> no convergence: respond fully elastic at el (elFE) ip ipc ', & @@ -1080,11 +1062,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) computeJacobian: if(updateJaco) then !$OMP PARALLEL DO PRIVATE(dSdF,dSdFe,dSdFi,dLpdS,dLpdFi,dFpinvdF,dLidS,dLidFi,dFidS,& - !$OMP rhs_3333,lhs_3333,temp_99,temp_33,temp_3333,myNcomponents,error) + !$OMP rhs_3333,lhs_3333,temp_99,temp_33,temp_3333,error) elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNcomponents = homogenization_Ngrains(mesh_element(3,e)) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed - do c = 1_pInt,myNcomponents + do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) call constitutive_SandItsTangents(temp_33,dSdFe,dSdFi,crystallite_Fe(1:3,1:3,c,i,e), & crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate elastic stress tangent @@ -1189,7 +1170,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo elementLooping6 !$OMP END PARALLEL DO endif computeJacobian -!why not OMP? end subroutine crystallite_stressAndItsTangent @@ -2248,8 +2228,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() + 0.5_pReal * sourceState(p)%p(mySource)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state enddo - !$OMP FLUSH(plasticStateResiduum) - !$OMP FLUSH(sourceStateResiduum) ! --- relative residui --- forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & @@ -2261,11 +2239,8 @@ subroutine crystallite_integrateStateAdaptiveEuler() relSourceStateResiduum(s,mySource,g,i,e) = & sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) enddo - !$OMP FLUSH(relPlasticStateResiduum) - !$OMP FLUSH(relSourceStateResiduum) #ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -2293,13 +2268,7 @@ subroutine crystallite_integrateStateAdaptiveEuler() abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) enddo - if (converged) then - crystallite_converged(g,i,e) = .true. ! ... converged per definitionem - if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (distributionState) - !$OMP END CRITICAL (distributionState) - endif - endif + if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definitionem endif enddo; enddo; enddo !$OMP ENDDO From 4b4cd4e6c31587478ee731c53979ca34d9105aee Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 19 Sep 2018 21:08:45 +0200 Subject: [PATCH 48/65] [skip ci] updated version information after successful test of v2.0.2-565-g59043d58 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cca202405..d3cb228fe 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-560-g20f0bee4 +v2.0.2-565-g59043d58 From 1623a33b486914b9c7ae2f2f3df4e8c99ebe694e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 19 Sep 2018 21:45:12 +0200 Subject: [PATCH 49/65] cleaning (mainly OMP FLUSh) --- src/crystallite.f90 | 3 --- src/homogenization.f90 | 17 ++--------------- 2 files changed, 2 insertions(+), 18 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f28c7cb00..ee15cb67b 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1855,9 +1855,6 @@ subroutine crystallite_integrateStateRKCK45() relSourceStateResiduum(s,mySource,g,i,e) = & sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%state(s,cc) enddo - !$OMP FLUSH(relPlasticStateResiduum) - !$OMP FLUSH(relSourceStateResiduum) -! @Martin: do we need flushing? why..? crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & rTol_crystalliteState .or. & abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 77d301400..a2b5d12e7 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -448,8 +448,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) subStepSizeHomog, & stepIncreaseHomog, & nMPstate - use math, only: & - math_transpose33 use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP, & @@ -524,9 +522,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & - math_transpose33(materialpoint_F0(1:3,1:3,debug_i,debug_e)) + transpose(materialpoint_F0(1:3,1:3,debug_i,debug_e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & - math_transpose33(materialpoint_F(1:3,1:3,debug_i,debug_e)) + transpose(materialpoint_F(1:3,1:3,debug_i,debug_e)) !$OMP END CRITICAL (write2out) endif @@ -608,10 +606,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) !--------------------------------------------------------------------------------------------------- ! calculate new subStep and new subFrac materialpoint_subFrac(i,e) = materialpoint_subFrac(i,e) + materialpoint_subStep(i,e) - !$OMP FLUSH(materialpoint_subFrac) materialpoint_subStep(i,e) = min(1.0_pReal-materialpoint_subFrac(i,e), & stepIncreaseHomog*materialpoint_subStep(i,e)) ! introduce flexibility for step increase/acceleration - !$OMP FLUSH(materialpoint_subStep) steppingNeeded: if (materialpoint_subStep(i,e) > subStepMinHomog) then @@ -671,7 +667,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & hydrogenfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal hydrogen transport state materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad - !$OMP FLUSH(materialpoint_subF0) endif steppingNeeded else converged @@ -689,7 +684,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) !$OMP END CRITICAL (setTerminallyIll) else ! cutback makes sense materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback - !$OMP FLUSH(materialpoint_subStep) #ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt & @@ -810,13 +804,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) materialpoint_doneAndHappy(1:2,i,e) = homogenization_updateState(i,e) materialpoint_converged(i,e) = all(materialpoint_doneAndHappy(1:2,i,e)) ! converged if done and happy endif - !$OMP FLUSH(materialpoint_converged) - if (materialpoint_converged(i,e)) then - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (distributionMPState) - !$OMP END CRITICAL (distributionMPState) - endif - endif endif enddo IpLooping3 enddo elementLooping3 From 6aa4dd842a1e5cfaadf6e455ffb2ac4482c76cf7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Sep 2018 06:09:02 +0200 Subject: [PATCH 50/65] define debug variables only if needed --- src/crystallite.f90 | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f28c7cb00..e1a444b2a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -142,12 +142,14 @@ subroutine crystallite_init compiler_version, & compiler_options #endif +#ifdef DEBUG use debug, only: & debug_info, & debug_reset, & debug_level, & debug_crystallite, & debug_levelBasic +#endif use numerics, only: & numerics_integrator, & worldrank, & @@ -437,8 +439,7 @@ subroutine crystallite_init call crystallite_stressAndItsTangent(.true.) ! request elastic answers -!-------------------------------------------------------------------------------------------------- -! debug output +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fe: ', shape(crystallite_Fe) write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fp: ', shape(crystallite_Fp) @@ -490,6 +491,7 @@ subroutine crystallite_init call debug_info call debug_reset +#endif end subroutine crystallite_init @@ -591,7 +593,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) real(pReal), dimension(9,9):: temp_99 logical :: error - +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt & .and. FEsolving_execElem(1) <= debug_e & .and. debug_e <= FEsolving_execElem(2)) then @@ -610,6 +612,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Li0', & transpose(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e)) endif +#endif !-------------------------------------------------------------------------------------------------- ! initialize to starting condition @@ -741,8 +744,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (all(crystallite_localPlasticity .or. crystallite_converged)) then if (all(crystallite_localPlasticity .or. crystallite_subStep + crystallite_subFrac >= 1.0_pReal)) then crystallite_clearToWindForward = .true. ! final wind forward +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a,i6)') '<< CRYST >> final wind forward' +#endif else !$OMP PARALLEL DO do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -751,8 +756,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo enddo !$OMP END PARALLEL DO +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a,i6)') '<< CRYST >> wind forward' +#endif endif else subFracIntermediate = maxval(crystallite_subFrac, mask=.not.crystallite_localPlasticity) @@ -838,8 +845,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo enddo !$OMP END PARALLEL DO +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a,i6)') '<< CRYST >> time synchronization: cutback' +#endif else !$OMP PARALLEL DO do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -848,8 +857,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo enddo !$OMP END PARALLEL DO +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a,i6)') '<< CRYST >> cutback' +#endif endif endif endif @@ -979,6 +990,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) timeSyncing2: if(numerics_timeSyncing) then if (any(.not. crystallite_localPlasticity .and. .not. crystallite_todo .and. .not. crystallite_converged & .and. crystallite_subStep <= subStepMinCryst)) then ! no way of rescuing a nonlocal ip that violated the lower time step limit, ... +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -990,6 +1002,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo enddo elementLooping4 endif +#endif where(.not. crystallite_localPlasticity) crystallite_todo = .false. ! ... so let all nonlocal ips die peacefully crystallite_subStep = 0.0_pReal @@ -997,6 +1010,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) endif endif timeSyncing2 +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then write(6,'(/,a,f8.5)') '<< CRYST >> min(subStep) ',minval(crystallite_subStep) write(6,'(a,f8.5)') '<< CRYST >> max(subStep) ',maxval(crystallite_subStep) @@ -1009,9 +1023,9 @@ subroutine crystallite_stressAndItsTangent(updateJaco) flush(6) endif endif +#endif ! --- integrate --- requires fully defined state array (basic + dependent state) - if (any(crystallite_todo)) call integrateState() where(.not. crystallite_converged .and. crystallite_subStep > subStepMinCryst) & ! do not try non-converged & fully cutbacked any further crystallite_todo = .true. @@ -1027,9 +1041,11 @@ subroutine crystallite_stressAndItsTangent(updateJaco) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do c = 1,homogenization_Ngrains(mesh_element(3,e)) if (.not. crystallite_converged(c,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) +#ifdef DEBUG if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> no convergence: respond fully elastic at el (elFE) ip ipc ', & e,'(',mesh_element(1,e),')',i,c +#endif invFp = math_inv33(crystallite_partionedFp0(1:3,1:3,c,i,e)) Fe_guess = math_mul33x33(math_mul33x33(crystallite_partionedF(1:3,1:3,c,i,e), invFp), & math_inv33(crystallite_partionedFi0(1:3,1:3,c,i,e))) @@ -1037,6 +1053,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_P(1:3,1:3,c,i,e) = math_mul33x33(math_mul33x33(crystallite_partionedF(1:3,1:3,c,i,e), invFp), & math_mul33x33(Tstar,transpose(invFp))) endif +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) & .or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then @@ -1053,6 +1070,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) transpose(crystallite_Li(1:3,1:3,c,i,e)) flush(6) endif +#endif enddo enddo enddo elementLooping5 From df0464c31bce615da018aca230ee4d702b8abd6f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Sep 2018 06:24:03 +0200 Subject: [PATCH 51/65] use (import) debug variables only when needed --- src/crystallite.f90 | 71 ++++++++++++++++++++++++++++----------------- 1 file changed, 44 insertions(+), 27 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index e1a444b2a..a7463b9af 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -177,8 +177,7 @@ subroutine crystallite_init use config, only: & config_deallocate, & config_crystallite, & - crystallite_name, & - material_Nphase + crystallite_name use constitutive, only: & constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state @@ -192,7 +191,6 @@ subroutine crystallite_init e, & !< counter in element loop o = 0_pInt, & !< counter in output loop r, & - ph, & !< counter in crystallite loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax, & !< maximum number of elements @@ -508,6 +506,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) subStepSizeCryst, & stepIncreaseCryst, & numerics_timeSyncing +#ifdef DEBUG use debug, only: & debug_level, & debug_crystallite, & @@ -517,6 +516,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) debug_e, & debug_i, & debug_g +#endif use IO, only: & IO_warning, & IO_error @@ -656,10 +656,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) NiterationCrystallite = 0_pInt cutbackLooping: do while (any(crystallite_todo(:,startIP:endIP,FEsolving_execELem(1):FEsolving_execElem(2)))) - +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a,i6)') '<< CRYST >> crystallite iteration ',NiterationCrystallite - +#endif timeSyncing1: if (any(.not. crystallite_localPlasticity) .and. numerics_timeSyncing) then ! Time synchronization can only be used for nonlocal calculations, and only there it makes sense. @@ -678,6 +678,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! and its not clear how to fix this, so all nonlocals become terminally ill. if (any(crystallite_syncSubFrac .and. .not. crystallite_converged(1,:,:))) then +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -686,6 +687,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo enddo endif +#endif crystallite_syncSubFrac = .false. where(.not. crystallite_localPlasticity) crystallite_substep = 0.0_pReal @@ -700,8 +702,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo enddo !$OMP END PARALLEL DO +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a,i6)') '<< CRYST >> time synchronization: wind forward' +#endif endif elseif (any(crystallite_syncSubFracCompleted)) then @@ -717,8 +721,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_clearToCutback(i,e) = crystallite_localPlasticity(1,i,e) .or. .not. crystallite_converged(1,i,e) enddo enddo +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a,i6)') '<< CRYST >> time synchronization: done, proceed with cutback' +#endif else ! Normal calculation. @@ -1198,17 +1204,17 @@ end subroutine crystallite_stressAndItsTangent subroutine crystallite_integrateStateRK4() use, intrinsic :: & IEEE_arithmetic - use debug, only: & #ifdef DEBUG + use debug, only: & debug_e, & debug_i, & debug_g, & -#endif debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & debug_levelSelective +#endif use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -1488,17 +1494,17 @@ end subroutine crystallite_integrateStateRK4 subroutine crystallite_integrateStateRKCK45() use, intrinsic :: & IEEE_arithmetic - use debug, only: & #ifdef DEBUG + use debug, only: & debug_e, & debug_i, & debug_g, & -#endif debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & debug_levelSelective +#endif use numerics, only: & rTol_crystalliteState use FEsolving, only: & @@ -1574,8 +1580,10 @@ subroutine crystallite_integrateStateRKCK45() singleRun ! flag indicating computation for single (g,i,e) triple eIter = FEsolving_execElem(1:2) +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,1x,i1)') '<< CRYST >> Runge--Kutta step',1 +#endif ! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP --- do e = eIter(1),eIter(2) @@ -1970,9 +1978,10 @@ subroutine crystallite_integrateStateRKCK45() ! --- nonlocal convergence check --- - +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' ! if not requesting Integration of just a single IP +#endif if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged @@ -1985,17 +1994,17 @@ end subroutine crystallite_integrateStateRKCK45 subroutine crystallite_integrateStateAdaptiveEuler() use, intrinsic :: & IEEE_arithmetic - use debug, only: & #ifdef DEBUG + use debug, only: & debug_e, & debug_i, & debug_g, & -#endif debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & debug_levelSelective +#endif use numerics, only: & rTol_crystalliteState use FEsolving, only: & @@ -2294,9 +2303,10 @@ subroutine crystallite_integrateStateAdaptiveEuler() ! --- NONLOCAL CONVERGENCE CHECK --- - +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' +#endif if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged @@ -2310,17 +2320,17 @@ end subroutine crystallite_integrateStateAdaptiveEuler subroutine crystallite_integrateStateEuler() use, intrinsic :: & IEEE_arithmetic - use debug, only: & #ifdef DEBUG + use debug, only: & debug_e, & debug_i, & debug_g, & -#endif debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & debug_levelSelective +#endif use numerics, only: & numerics_timeSyncing use FEsolving, only: & @@ -2524,17 +2534,17 @@ end subroutine crystallite_integrateStateEuler subroutine crystallite_integrateStateFPI() use, intrinsic :: & IEEE_arithmetic - use debug, only: & #ifdef DEBUG + use debug, only: & debug_e, & debug_i, & debug_g, & -#endif debug_level,& debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & debug_levelSelective +#endif use numerics, only: & nState, & rTol_crystalliteState @@ -2598,8 +2608,10 @@ subroutine crystallite_integrateStateFPI() singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo at start of state integration' +#endif !-------------------------------------------------------------------------------------------------- ! initialize dotState @@ -2654,8 +2666,10 @@ subroutine crystallite_integrateStateFPI() NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%dotState(:,c))) enddo if (NaN) then ! NaN occured in any dotState +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,*) '<< CRYST >> dotstate ',plasticState(p)%dotState(:,c) +#endif if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken is a non-local... !$OMP CRITICAL (checkTodo) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals done (and broken) @@ -2669,9 +2683,10 @@ subroutine crystallite_integrateStateFPI() !$OMP ENDDO ! --- UPDATE STATE --- +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after preguess of state' - +#endif !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains @@ -2727,9 +2742,10 @@ subroutine crystallite_integrateStateFPI() ! --- STRESS INTEGRATION --- +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo before stress integration' - +#endif !$OMP DO do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) @@ -2745,13 +2761,10 @@ subroutine crystallite_integrateStateFPI() enddo; enddo; enddo !$OMP ENDDO - !$OMP SINGLE - !$OMP CRITICAL (write2out) +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after stress integration' - !$OMP END CRITICAL (write2out) - !$OMP END SINGLE - +#endif ! --- DOT STATE --- @@ -2940,10 +2953,11 @@ subroutine crystallite_integrateStateFPI() !$OMP ENDDO !$OMP END PARALLEL +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & ' grains converged after state integration #', NiterationState - +#endif ! --- NON-LOCAL CONVERGENCE CHECK --- @@ -2952,12 +2966,15 @@ subroutine crystallite_integrateStateFPI() crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & ' grains converged after non-local check' write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_todo(:,:,:)), & ' grains todo after state integration #', NiterationState endif +#endif + ! --- CHECK IF DONE WITH INTEGRATION --- doneWithIntegration = .true. @@ -3118,16 +3135,16 @@ logical function crystallite_integrateStress(& iJacoLpresiduum, & subStepSizeLp, & subStepSizeLi - use debug, only: debug_level, & #ifdef DEBUG + use debug, only: debug_level, & debug_e, & debug_i, & debug_g, & -#endif debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & debug_levelSelective +#endif use constitutive, only: constitutive_LpAndItsTangents, & constitutive_LiAndItsTangents, & From 901355d2ae62409be8d3adfea0de93103c0a16e4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Sep 2018 06:27:53 +0200 Subject: [PATCH 52/65] don't use unnecessarily long names --- src/crystallite.f90 | 86 ++++++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 43 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index a7463b9af..74f49920d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -122,13 +122,13 @@ module crystallite crystallite_postResults private :: & integrateState, & - crystallite_integrateStateFPI, & - crystallite_integrateStateEuler, & - crystallite_integrateStateAdaptiveEuler, & - crystallite_integrateStateRK4, & - crystallite_integrateStateRKCK45, & - crystallite_integrateStress, & - crystallite_stateJump + integrateStateFPI, & + integrateStateEuler, & + integrateStateAdaptiveEuler, & + integrateStateRK4, & + integrateStateRKCK45, & + integrateStress, & + stateJump contains @@ -272,15 +272,15 @@ subroutine crystallite_init select case(numerics_integrator(1)) case(1_pInt) - integrateState => crystallite_integrateStateFPI + integrateState => integrateStateFPI case(2_pInt) - integrateState => crystallite_integrateStateEuler + integrateState => integrateStateEuler case(3_pInt) - integrateState => crystallite_integrateStateAdaptiveEuler + integrateState => integrateStateAdaptiveEuler case(4_pInt) - integrateState => crystallite_integrateStateRK4 + integrateState => integrateStateRK4 case(5_pInt) - integrateState => crystallite_integrateStateRKCK45 + integrateState => integrateStateRKCK45 end select @@ -1201,7 +1201,7 @@ end subroutine crystallite_stressAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 4th order explicit Runge Kutta method !-------------------------------------------------------------------------------------------------- -subroutine crystallite_integrateStateRK4() +subroutine integrateStateRK4() use, intrinsic :: & IEEE_arithmetic #ifdef DEBUG @@ -1382,7 +1382,7 @@ subroutine crystallite_integrateStateRK4() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_stateJump(g,i,e) + crystallite_todo(g,i,e) = stateJump(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -1413,7 +1413,7 @@ subroutine crystallite_integrateStateRK4() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e,timeStepFraction(n)) ! fraction of original times step + crystallite_todo(g,i,e) = integrateStress(g,i,e,timeStepFraction(n)) ! fraction of original times step !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -1484,14 +1484,14 @@ subroutine crystallite_integrateStateRK4() endif endif -end subroutine crystallite_integrateStateRK4 +end subroutine integrateStateRK4 !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 5th order Runge-Kutta Cash-Karp method with !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- -subroutine crystallite_integrateStateRKCK45() +subroutine integrateStateRKCK45() use, intrinsic :: & IEEE_arithmetic #ifdef DEBUG @@ -1703,7 +1703,7 @@ subroutine crystallite_integrateStateRKCK45() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_stateJump(g,i,e) + crystallite_todo(g,i,e) = stateJump(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -1734,7 +1734,7 @@ subroutine crystallite_integrateStateRKCK45() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e,C(stage)) ! fraction of original time step + crystallite_todo(g,i,e) = integrateStress(g,i,e,C(stage)) ! fraction of original time step !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -1923,7 +1923,7 @@ subroutine crystallite_integrateStateRKCK45() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_stateJump(g,i,e) + crystallite_todo(g,i,e) = stateJump(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -1954,7 +1954,7 @@ subroutine crystallite_integrateStateRKCK45() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e) + crystallite_todo(g,i,e) = integrateStress(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -1985,13 +1985,13 @@ subroutine crystallite_integrateStateRKCK45() if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged -end subroutine crystallite_integrateStateRKCK45 +end subroutine integrateStateRKCK45 !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine crystallite_integrateStateAdaptiveEuler() +subroutine integrateStateAdaptiveEuler() use, intrinsic :: & IEEE_arithmetic #ifdef DEBUG @@ -2150,7 +2150,7 @@ subroutine crystallite_integrateStateAdaptiveEuler() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_stateJump(g,i,e) + crystallite_todo(g,i,e) = stateJump(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -2182,7 +2182,7 @@ subroutine crystallite_integrateStateAdaptiveEuler() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e) + crystallite_todo(g,i,e) = integrateStress(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) @@ -2311,13 +2311,13 @@ subroutine crystallite_integrateStateAdaptiveEuler() crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged -end subroutine crystallite_integrateStateAdaptiveEuler +end subroutine integrateStateAdaptiveEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, and state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine crystallite_integrateStateEuler() +subroutine integrateStateEuler() use, intrinsic :: & IEEE_arithmetic #ifdef DEBUG @@ -2458,7 +2458,7 @@ eIter = FEsolving_execElem(1:2) do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_stateJump(g,i,e) + crystallite_todo(g,i,e) = stateJump(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e) & ! if broken non-local... .and. .not. numerics_timeSyncing) then @@ -2492,7 +2492,7 @@ eIter = FEsolving_execElem(1:2) do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e) + crystallite_todo(g,i,e) = integrateStress(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e) & ! if broken non-local... .and. .not. numerics_timeSyncing) then @@ -2524,14 +2524,14 @@ eIter = FEsolving_execElem(1:2) crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif -end subroutine crystallite_integrateStateEuler +end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine crystallite_integrateStateFPI() +subroutine integrateStateFPI() use, intrinsic :: & IEEE_arithmetic #ifdef DEBUG @@ -2750,7 +2750,7 @@ subroutine crystallite_integrateStateFPI() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e) + crystallite_todo(g,i,e) = integrateStress(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! broken non-local... !$OMP CRITICAL (checkTodo) @@ -2938,7 +2938,7 @@ subroutine crystallite_integrateStateFPI() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. crystallite_converged(g,i,e)) then ! converged and still alive... - crystallite_todo(g,i,e) = crystallite_stateJump(g,i,e) + crystallite_todo(g,i,e) = stateJump(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e)) then ! if state jump fails, then convergence is broken crystallite_converged(g,i,e) = .false. @@ -2988,14 +2988,14 @@ subroutine crystallite_integrateStateFPI() enddo elemLoop enddo crystalliteLooping -end subroutine crystallite_integrateStateFPI +end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief calculates a jump in the state according to the current state and the current stress !> returns true, if state jump was successfull or not needed. false indicates NaN in delta state !-------------------------------------------------------------------------------------------------- -logical function crystallite_stateJump(ipc,ip,el) +logical function stateJump(ipc,ip,el) use, intrinsic :: & IEEE_arithmetic use prec, only: & @@ -3045,7 +3045,7 @@ logical function crystallite_stateJump(ipc,ip,el) mySizePlasticDeltaState = plasticState(p)%sizeDeltaState if( any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c)))) then ! NaN occured in deltaState - crystallite_stateJump = .false. + stateJump = .false. return endif @@ -3059,7 +3059,7 @@ logical function crystallite_stateJump(ipc,ip,el) myOffsetSourceDeltaState = sourceState(p)%p(mySource)%offsetDeltaState mySizeSourceDeltaState = sourceState(p)%p(mySource)%sizeDeltaState if (any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c)))) then ! NaN occured in deltaState - crystallite_stateJump = .false. + stateJump = .false. return endif sourceState(p)%p(mySource)%state(myOffsetSourceDeltaState + 1_pInt : & @@ -3082,9 +3082,9 @@ logical function crystallite_stateJump(ipc,ip,el) endif #endif - crystallite_stateJump = .true. + stateJump = .true. -end function crystallite_stateJump +end function stateJump !-------------------------------------------------------------------------------------------------- @@ -3118,7 +3118,7 @@ end function crystallite_push33ToRef !> @brief calculation of stress (P) with time integration based on a residuum in Lp and !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- -logical function crystallite_integrateStress(& +logical function integrateStress(& ipc,& ! grain number ip,& ! integration point number el,& ! element number @@ -3236,7 +3236,7 @@ logical function crystallite_integrateStress(& dgesv !* be pessimistic - crystallite_integrateStress = .false. + integrateStress = .false. #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -3575,7 +3575,7 @@ logical function crystallite_integrateStress(& !* set return flag to true - crystallite_integrateStress = .true. + integrateStress = .true. #ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -3590,7 +3590,7 @@ logical function crystallite_integrateStress(& endif #endif -end function crystallite_integrateStress +end function integrateStress !-------------------------------------------------------------------------------------------------- From fcff6b908a444c515a5c06c2cdfa96a9476b734f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Sep 2018 06:35:30 +0200 Subject: [PATCH 53/65] can be easily computed during post processing --- examples/ConfigFiles/Crystallite_All.config | 11 ++--- src/crystallite.f90 | 45 ++------------------- 2 files changed, 6 insertions(+), 50 deletions(-) diff --git a/examples/ConfigFiles/Crystallite_All.config b/examples/ConfigFiles/Crystallite_All.config index 761380fcd..d46c3e0e6 100644 --- a/examples/ConfigFiles/Crystallite_All.config +++ b/examples/ConfigFiles/Crystallite_All.config @@ -5,15 +5,10 @@ (output) orientation # quaternion (output) eulerangles # orientation as Bunge triple in degree (output) grainrotation # deviation from initial orientation as axis (1-3) and angle in degree (4) in crystal reference coordinates -(output) grainrotationx # deviation from initial orientation as angle in degrees around sample reference x axis -(output) grainrotationy # deviation from initial orientation as angle in degrees around sample reference y axis -(output) grainrotationz # deviation from initial orientation as angle in degrees around sample reference z axis -(output) f # deformation gradient tensor; synonyms: "defgrad" +(output) f # deformation gradient tensor (output) fe # elastic deformation gradient tensor (output) fp # plastic deformation gradient tensor -(output) e # total strain as Green-Lagrange tensor -(output) ee # elastic strain as Green-Lagrange tensor -(output) p # first Piola-Kichhoff stress tensor; synonyms: "firstpiola", "1stpiola" -(output) s # second Piola-Kichhoff stress tensor; synonyms: "tstar", "secondpiola", "2ndpiola" +(output) p # first Piola-Kichhoff stress tensor +(output) s # second Piola-Kichhoff stress tensor (output) lp # plastic velocity gradient tensor (output) elasmatrix # elastic stiffness matrix diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 74f49920d..b079c7c72 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -90,9 +90,6 @@ module crystallite phase_ID, & texture_ID, & volume_ID, & - grainrotationx_ID, & - grainrotationy_ID, & - grainrotationz_ID, & orientation_ID, & grainrotation_ID, & eulerangles_ID, & @@ -102,8 +99,6 @@ module crystallite fi_ID, & lp_ID, & li_ID, & - e_ID, & - ee_ID, & p_ID, & s_ID, & elasmatrix_ID, & @@ -302,12 +297,6 @@ subroutine crystallite_init crystallite_outputID(o,c) = texture_ID case ('volume') outputName crystallite_outputID(o,c) = volume_ID - case ('grainrotationx') outputName - crystallite_outputID(o,c) = grainrotationx_ID - case ('grainrotationy') outputName - crystallite_outputID(o,c) = grainrotationy_ID - case ('grainrotationz') outputName - crystallite_outputID(o,c) = grainrotationx_ID case ('orientation') outputName crystallite_outputID(o,c) = orientation_ID case ('grainrotation') outputName @@ -326,10 +315,6 @@ subroutine crystallite_init crystallite_outputID(o,c) = lp_ID case ('li') outputName crystallite_outputID(o,c) = li_ID - case ('e') outputName - crystallite_outputID(o,c) = e_ID - case ('ee') outputName - crystallite_outputID(o,c) = ee_ID case ('p','firstpiola','1stpiola') outputName crystallite_outputID(o,c) = p_ID case ('s','tstar','secondpiola','2ndpiola') outputName @@ -350,13 +335,13 @@ subroutine crystallite_init do r = 1_pInt,size(config_crystallite) do o = 1_pInt,crystallite_Noutput(r) select case(crystallite_outputID(o,r)) - case(phase_ID,texture_ID,volume_ID,grainrotationx_ID,grainrotationy_ID,grainrotationz_ID) + case(phase_ID,texture_ID,volume_ID) mySize = 1_pInt case(orientation_ID,grainrotation_ID) mySize = 4_pInt case(eulerangles_ID) mySize = 3_pInt - case(defgrad_ID,fe_ID,fp_ID,fi_ID,lp_ID,li_ID,e_ID,ee_ID,p_ID,s_ID) + case(defgrad_ID,fe_ID,fp_ID,fi_ID,lp_ID,li_ID,p_ID,s_ID) mySize = 9_pInt case(elasmatrix_ID) mySize = 36_pInt @@ -3706,9 +3691,7 @@ function crystallite_postResults(ipc, ip, el) math_det33, & math_I3, & inDeg, & - math_Mandel6to33, & - math_qMul, & - math_qConj + math_Mandel6to33 use mesh, only: & mesh_element, & mesh_ipVolume, & @@ -3786,18 +3769,6 @@ function crystallite_postResults(ipc, ip, el) crystallite_postResults(c+1:c+mySize) = & math_qToEulerAxisAngle(crystallite_rotation(1:4,ipc,ip,el)) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates crystallite_postResults(c+4) = inDeg * crystallite_postResults(c+4) ! angle in degree - case (grainrotationx_ID) - mySize = 1_pInt - rotation = math_qToEulerAxisAngle(crystallite_rotation(1:4,ipc,ip,el)) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates - crystallite_postResults(c+1) = inDeg * rotation(1) * rotation(4) ! angle in degree - case (grainrotationy_ID) - mySize = 1_pInt - rotation = math_qToEulerAxisAngle(crystallite_rotation(1:4,ipc,ip,el)) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates - crystallite_postResults(c+1) = inDeg * rotation(2) * rotation(4) ! angle in degree - case (grainrotationz_ID) - mySize = 1_pInt - rotation = math_qToEulerAxisAngle(crystallite_rotation(1:4,ipc,ip,el)) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates - crystallite_postResults(c+1) = inDeg * rotation(3) * rotation(4) ! angle in degree ! remark: tensor output is of the form 11,12,13, 21,22,23, 31,32,33 ! thus row index i is slow, while column index j is fast. reminder: "row is slow" @@ -3806,20 +3777,10 @@ function crystallite_postResults(ipc, ip, el) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & reshape(transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize]) - case (e_ID) - mySize = 9_pInt - crystallite_postResults(c+1:c+mySize) = 0.5_pReal * reshape((math_mul33x33( & - transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)), & - crystallite_partionedF(1:3,1:3,ipc,ip,el)) - math_I3),[mySize]) case (fe_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & reshape(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize]) - case (ee_ID) - Ee = 0.5_pReal *(math_mul33x33(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)), & - crystallite_Fe(1:3,1:3,ipc,ip,el)) - math_I3) - mySize = 9_pInt - crystallite_postResults(c+1:c+mySize) = reshape(Ee,[mySize]) case (fp_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & From 310ea62964a9dfeee83df3ba4cddfecb014239ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Sep 2018 06:58:31 +0200 Subject: [PATCH 54/65] only print out the essential information --- .../Polycrystal/material.config | 2 - src/crystallite.f90 | 58 ++----------------- 2 files changed, 6 insertions(+), 54 deletions(-) diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 5073f165e..eebb17473 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -18,8 +18,6 @@ mech none (output) f # deformation gradient tensor; synonyms: "defgrad" (output) fe # elastic deformation gradient tensor (output) fp # plastic deformation gradient tensor -(output) e # total strain as Green-Lagrange tensor -(output) ee # elastic strain as Green-Lagrange tensor (output) p # first Piola-Kichhoff stress tensor; synonyms: "firstpiola", "1stpiola" (output) lp # plastic velocity gradient tensor diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b079c7c72..5f447664d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -194,8 +194,6 @@ subroutine crystallite_init mySize character(len=65536), dimension(:), allocatable :: str - character(len=65536) :: & - tag = '' write(6,'(/,a)') ' <<<+- crystallite init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -326,7 +324,7 @@ subroutine crystallite_init case ('neighboringelement') outputName crystallite_outputID(o,c) = neighboringelement_ID case default outputName - call IO_error(105_pInt,ext_msg=tag//' (Crystallite)') + call IO_error(105_pInt,ext_msg=trim(str(o))//' (Crystallite)') end select outputName enddo enddo @@ -424,51 +422,11 @@ subroutine crystallite_init #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fe: ', shape(crystallite_Fe) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fp: ', shape(crystallite_Fp) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fi: ', shape(crystallite_Fi) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Lp: ', shape(crystallite_Lp) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Li: ', shape(crystallite_Li) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_F0: ', shape(crystallite_F0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fp0: ', shape(crystallite_Fp0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Fi0: ', shape(crystallite_Fi0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Lp0: ', shape(crystallite_Lp0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Li0: ', shape(crystallite_Li0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedF: ', shape(crystallite_partionedF) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedF0: ', shape(crystallite_partionedF0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedFp0: ', shape(crystallite_partionedFp0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedFi0: ', shape(crystallite_partionedFi0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedLp0: ', shape(crystallite_partionedLp0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedLi0: ', shape(crystallite_partionedLi0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF: ', shape(crystallite_subF) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF0: ', shape(crystallite_subF0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFp0: ', shape(crystallite_subFp0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFi0: ', shape(crystallite_subFi0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subLp0: ', shape(crystallite_subLp0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subLi0: ', shape(crystallite_subLi0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_P: ', shape(crystallite_P) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Tstar_v: ', shape(crystallite_Tstar_v) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_Tstar0_v: ', shape(crystallite_Tstar0_v) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedTstar0_v: ', shape(crystallite_partionedTstar0_v) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subTstar0_v: ', shape(crystallite_subTstar0_v) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_dPdF: ', shape(crystallite_dPdF) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_dPdF0: ', shape(crystallite_dPdF0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_partioneddPdF0: ', shape(crystallite_partioneddPdF0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_orientation: ', shape(crystallite_orientation) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_orientation0: ', shape(crystallite_orientation0) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_rotation: ', shape(crystallite_rotation) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_disorientation: ', shape(crystallite_disorientation) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_dt: ', shape(crystallite_dt) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subdt: ', shape(crystallite_subdt) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFrac: ', shape(crystallite_subFrac) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_subStep: ', shape(crystallite_subStep) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_localPlasticity: ', shape(crystallite_localPlasticity) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_requested: ', shape(crystallite_requested) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_todo: ', shape(crystallite_todo) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_converged: ', shape(crystallite_converged) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_sizePostResults: ', shape(crystallite_sizePostResults) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_sizePostResult: ', shape(crystallite_sizePostResult) - write(6,'(/,a35,1x,i10)') 'Number of nonlocal grains: ',count(.not. crystallite_localPlasticity) + write(6,'(a42,1x,i10)') ' # of elements: ', eMax + write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax + write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax + write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', nMax + write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity) flush(6) endif @@ -3722,10 +3680,6 @@ function crystallite_postResults(ipc, ip, el) 1+plasticState(material_phase(ipc,ip,el))%sizePostResults + & sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: & crystallite_postResults - real(pReal), dimension(3,3) :: & - Ee - real(pReal), dimension(4) :: & - rotation real(pReal) :: & detF integer(pInt) :: & From 3e7b80a3efb296f7d2fa0476f618daefdc3b80e2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Sep 2018 07:27:12 +0200 Subject: [PATCH 55/65] debug only available if compiled in debug mode --- src/homogenization.f90 | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index a2b5d12e7..82a97dc53 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -494,6 +494,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_converged, & crystallite_stressAndItsTangent, & crystallite_orientations +#ifdef DEBUG use debug, only: & debug_level, & debug_homogenization, & @@ -502,6 +503,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) debug_levelSelective, & debug_e, & debug_i +#endif implicit none real(pReal), intent(in) :: dt !< time increment @@ -515,18 +517,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) mySource, & myNgrains -!-------------------------------------------------------------------------------------------------- -! initialize to starting condition +#ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & transpose(materialpoint_F0(1:3,1:3,debug_i,debug_e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & transpose(materialpoint_F(1:3,1:3,debug_i,debug_e)) - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! initialize restoration points of ... @@ -746,8 +746,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) if (materialpoint_subStep(i,e) > subStepMinHomog) then materialpoint_requested(i,e) = .true. - materialpoint_subF(1:3,1:3,i,e) = materialpoint_subF0(1:3,1:3,i,e) + & - materialpoint_subStep(i,e) * (materialpoint_F(1:3,1:3,i,e) - materialpoint_F0(1:3,1:3,i,e)) + materialpoint_subF(1:3,1:3,i,e) = materialpoint_subF0(1:3,1:3,i,e) & + + materialpoint_subStep(i,e) * (materialpoint_F(1:3,1:3,i,e) & + - materialpoint_F0(1:3,1:3,i,e)) materialpoint_subdt(i,e) = materialpoint_subStep(i,e) * dt materialpoint_doneAndHappy(1:2,i,e) = [.false.,.true.] endif @@ -825,9 +826,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) enddo elementLooping4 !$OMP END PARALLEL DO else - !$OMP CRITICAL (write2out) write(6,'(/,a,/)') '<< HOMOG >> Material Point terminally ill' - !$OMP END CRITICAL (write2out) endif end subroutine materialpoint_stressAndItsTangent From 24f1e57d44d6d4cceb2b8aa41dbcfdb46f514f33 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 20 Sep 2018 07:54:27 +0200 Subject: [PATCH 56/65] [skip ci] updated version information after successful test of v2.0.2-566-g11d4c28d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cca202405..5b2c5b2a9 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-560-g20f0bee4 +v2.0.2-566-g11d4c28d From c1c7283e5e34de5c7dc99e83914ac4ecd281523d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Sep 2018 20:08:32 +0200 Subject: [PATCH 57/65] tests failed because of legacy output --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 2c40bb79f..aeae4513b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 2c40bb79f9a57d2178eb7be0e533fd5104f9f87e +Subproject commit aeae4513b1ffb43b949399c12bae27fc6abb6f29 From 81a95b51588affc0ef40fb399d4fbac1f09bbf11 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 21 Sep 2018 08:23:30 +0200 Subject: [PATCH 58/65] [skip ci] updated version information after successful test of v2.0.2-580-gc1c7283e --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index d3cb228fe..8e8aa762e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-565-g59043d58 +v2.0.2-580-gc1c7283e From 0710609ce0e1b2dd8d35d78844b16480c5cbdebf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 26 Sep 2018 09:02:52 +0200 Subject: [PATCH 59/65] ignore symlinks --- installation/patch/python2to3.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/installation/patch/python2to3.sh b/installation/patch/python2to3.sh index 1d86b0ce7..07eed0e1e 100755 --- a/installation/patch/python2to3.sh +++ b/installation/patch/python2to3.sh @@ -1,8 +1,8 @@ #! /usr/bin/env bash if [ $1x != 3to2x ]; then echo 'python2.7 to python' - find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python2.7/usr\/bin\/env python/g' + find . -name '*.py' -type f | xargs sed -i 's/usr\/bin\/env python2.7/usr\/bin\/env python/g' else echo 'python to python2.7' - find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python/usr\/bin\/env python2.7/g' + find . -name '*.py' -type f | xargs sed -i 's/usr\/bin\/env python/usr\/bin\/env python2.7/g' fi From b391ad304d3f920aeb82e37855da7fe868b23bd4 Mon Sep 17 00:00:00 2001 From: Chuanlai Liu Date: Thu, 27 Sep 2018 11:53:45 +0200 Subject: [PATCH 60/65] tensor input/output is of the form 11,12,13, 21,22,23, 31,32,33. Thus row index i is slow, while column index j is fast --- src/homogenization_RGC.f90 | 4 ++-- src/homogenization_isostrain.f90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 92ea5301d..1d7bc6f86 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -942,10 +942,10 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) do o = 1_pInt,homogenization_Noutput(mesh_element(3,el)) select case(homogenization_RGC_outputID(o,homID)) case (avgdefgrad_ID) - homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(avgF,[9]) + homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgF),[9]) c = c + 9_pInt case (avgfirstpiola_ID) - homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(avgP,[9]) + homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgP),[9]) c = c + 9_pInt case (ipcoords_ID) homogenization_RGC_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el) ! current ip coordinates diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 8ee0df73d..24aedf75f 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -300,10 +300,10 @@ pure function homogenization_isostrain_postResults(ip,el,avgP,avgF) homogenization_isostrain_postResults(c+1_pInt) = real(homogenization_isostrain_Ngrains(homID),pReal) c = c + 1_pInt case (avgdefgrad_ID) - homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(avgF,[9]) + homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgF),[9]) c = c + 9_pInt case (avgfirstpiola_ID) - homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(avgP,[9]) + homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgP),[9]) c = c + 9_pInt case (ipcoords_ID) homogenization_isostrain_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el) ! current ip coordinates From 03d81c48fb5d01c0a7df37e4656b9e7d4d4e0700 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 27 Sep 2018 13:21:24 +0200 Subject: [PATCH 61/65] [skip ci] updated version information after successful test of v2.0.2-582-g0710609c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8e8aa762e..551bf8f07 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-580-gc1c7283e +v2.0.2-582-g0710609c From 273874d3fba6e6b2002e0e5cae2ab0a7a8cbdae3 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 27 Sep 2018 14:19:10 -0400 Subject: [PATCH 62/65] slightly more picky in what exceptions to catch, now complain when losing all labels --- lib/damask/asciitable.py | 79 ++++++++++++++++++++-------------------- 1 file changed, 40 insertions(+), 39 deletions(-) diff --git a/lib/damask/asciitable.py b/lib/damask/asciitable.py index c47dbd8a7..927f7e106 100644 --- a/lib/damask/asciitable.py +++ b/lib/damask/asciitable.py @@ -1,14 +1,14 @@ # -*- coding: UTF-8 no BOM -*- -import os,sys +import os, sys import numpy as np # ------------------------------------------------------------------ # python 3 has no unicode object, this ensures that the code works on Python 2&3 try: - test=isinstance('test', unicode) -except(NameError): - unicode=str + test = isinstance('test', unicode) +except NameError: + unicode = str # ------------------------------------------------------------------ class ASCIItable(): @@ -63,16 +63,17 @@ class ASCIItable(): x): try: return float(x) - except: + except ValueError: return 0.0 # ------------------------------------------------------------------ def _removeCRLF(self, - string): + string): + """delete any carriage return and line feed from string""" try: return string.replace('\n','').replace('\r','') - except: - return string + except AttributeError: + return str(string) # ------------------------------------------------------------------ @@ -93,22 +94,22 @@ class ASCIItable(): # ------------------------------------------------------------------ def input_close(self): - try: +# try: if self.__IO__['in'] != sys.stdin: self.__IO__['in'].close() - except: - pass +# except: +# pass # ------------------------------------------------------------------ def output_write(self, what): """Aggregate a single row (string) or list of (possibly containing further lists of) rows into output""" - if not isinstance(what, (str, unicode)): + if isinstance(what, (str, unicode)): + self.__IO__['output'] += [what] + else: try: for item in what: self.output_write(item) - except: + except TypeError: self.__IO__['output'] += [str(what)] - else: - self.__IO__['output'] += [what] return self.__IO__['buffered'] or self.output_flush() @@ -129,10 +130,10 @@ class ASCIItable(): # ------------------------------------------------------------------ def output_close(self, dismiss = False): - try: - if self.__IO__['out'] != sys.stdout: self.__IO__['out'].close() - except: - pass +# try: + if self.__IO__['out'] != sys.stdout: self.__IO__['out'].close() +# except: +# pass if dismiss and os.path.isfile(self.__IO__['out'].name): os.remove(self.__IO__['out'].name) elif self.__IO__['inPlace']: @@ -150,7 +151,7 @@ class ASCIItable(): try: self.__IO__['in'].seek(0) - except: + except IOError: pass firstline = self.__IO__['in'].readline().strip() @@ -170,7 +171,7 @@ class ASCIItable(): else: # other table format try: self.__IO__['in'].seek(0) # try to rewind - except: + except IOError: self.__IO__['readBuffer'] = [firstline] # or at least save data in buffer while self.data_read(advance = False, respectLabels = False): @@ -197,7 +198,9 @@ class ASCIItable(): """Write current header information (info + labels)""" head = ['{}\theader'.format(len(self.info)+self.__IO__['labeled'])] if header else [] head.append(self.info) - if self.__IO__['labeled']: head.append('\t'.join(map(self._quote,self.tags))) + if self.__IO__['labeled']: + head.append('\t'.join(map(self._quote,self.tags))) + if len(self.tags) == 0: raise ValueError('no labels present.') return self.output_write(head) @@ -257,13 +260,13 @@ class ASCIItable(): what, reset = False): """Add item or list to existing set of labels (and switch on labeling)""" - if not isinstance(what, (str, unicode)): + if isinstance(what, (str, unicode)): + self.tags += [self._removeCRLF(what)] + else: try: for item in what: self.labels_append(item) - except: + except TypeError: self.tags += [self._removeCRLF(str(what))] - else: - self.tags += [self._removeCRLF(what)] self.__IO__['labeled'] = True # switch on processing (in particular writing) of tags if reset: self.__IO__['tags'] = list(self.tags) # subsequent data_read uses current tags as data size @@ -410,13 +413,13 @@ class ASCIItable(): def info_append(self, what): """Add item or list to existing set of infos""" - if not isinstance(what, (str, unicode)): + if isinstance(what, (str, unicode)): + self.info += [self._removeCRLF(what)] + else: try: for item in what: self.info_append(item) - except: + except TypeError: self.info += [self._removeCRLF(str(what))] - else: - self.info += [self._removeCRLF(what)] # ------------------------------------------------------------------ def info_clear(self): @@ -468,10 +471,8 @@ class ASCIItable(): """Read whole data of all (given) labels as numpy array""" from collections import Iterable - try: - self.data_rewind() # try to wind back to start of data - except: - pass # assume/hope we are at data start already... + try: self.data_rewind() # try to wind back to start of data + except: pass # assume/hope we are at data start already... if labels is None or labels == []: use = None # use all columns (and keep labels intact) @@ -530,13 +531,13 @@ class ASCIItable(): # ------------------------------------------------------------------ def data_append(self, what): - if not isinstance(what, (str, unicode)): + if isinstance(what, (str, unicode)): + self.data += [what] + else: try: for item in what: self.data_append(item) - except: + except TypeError: self.data += [str(what)] - else: - self.data += [what] # ------------------------------------------------------------------ def data_set(self, @@ -581,7 +582,7 @@ class ASCIItable(): if len(items) > 2: if items[1].lower() == 'of': items = np.ones(datatype(items[0]))*datatype(items[2]) - elif items[1].lower() == 'to': + elif items[1].lower() == 'to': items = np.linspace(datatype(items[0]),datatype(items[2]), abs(datatype(items[2])-datatype(items[0]))+1,dtype=int) else: items = list(map(datatype,items)) From 56c7b2e433d1e9c7a76ebe91d29fb4901062daca Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 29 Sep 2018 00:49:43 +0200 Subject: [PATCH 63/65] [skip ci] updated version information after successful test of v2.0.2-583-gb391ad30 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8e8aa762e..079bea7b2 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-580-gc1c7283e +v2.0.2-583-gb391ad30 From a00d15b88905afc0bb5b8aab6ec9c9188de10b44 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 29 Sep 2018 11:18:35 +0200 Subject: [PATCH 64/65] geom files are not labeled --- processing/pre/geom_fromOsteonGeometry.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/processing/pre/geom_fromOsteonGeometry.py b/processing/pre/geom_fromOsteonGeometry.py index 807e5200e..dc481ef97 100755 --- a/processing/pre/geom_fromOsteonGeometry.py +++ b/processing/pre/geom_fromOsteonGeometry.py @@ -65,7 +65,7 @@ if np.any(np.array(options.size) <= 0.0): if filename == []: filename = [None] table = damask.ASCIItable(outname = filename[0], - buffered = False) + buffered = False, labeled=False) damask.util.report(scriptName,filename[0]) From bd882bb39ea1aeca9fb4da1065ad71d2d4cebc77 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 30 Sep 2018 00:12:50 +0200 Subject: [PATCH 65/65] [skip ci] updated version information after successful test of v2.0.2-591-ga00d15b8 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 551bf8f07..26c337c96 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-582-g0710609c +v2.0.2-591-ga00d15b8