From 510c0da02c60ee3038de9035ba9372d4dade59a9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Mar 2019 08:55:25 +0100 Subject: [PATCH 01/19] more systematic names --- src/plastic_nonlocal.f90 | 172 +++++++++++++++++++-------------------- 1 file changed, 86 insertions(+), 86 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index f35950620..20bc9bc6d 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -37,16 +37,16 @@ module plastic_nonlocal enum, bind(c) enumerator :: undefined_ID, & - rho_sgl_edge_pos_mobile_ID, & - rho_sgl_edge_neg_mobile_ID, & - rho_sgl_screw_pos_mobile_ID, & - rho_sgl_screw_neg_mobile_ID, & - rho_sgl_edge_pos_immobile_ID, & - rho_sgl_edge_neg_immobile_ID, & - rho_sgl_screw_pos_immobile_ID, & - rho_sgl_screw_neg_immobile_ID, & - rho_dip_edge_ID, & - rho_dip_screw_ID, & + rho_sgl_mob_edg_pos_ID, & + rho_sgl_mob_edg_neg_ID, & + rho_sgl_mob_scr_pos_ID, & + rho_sgl_mob_scr_neg_ID, & + rho_sgl_imm_edg_pos_ID, & + rho_sgl_imm_edg_neg_ID, & + rho_sgl_imm_scr_pos_ID, & + rho_sgl_imm_scr_neg_ID, & + rho_dip_edg_ID, & + rho_dip_scr_ID, & rho_forest_ID, & shearrate_ID, & resolvedstress_ID, & @@ -177,18 +177,18 @@ module plastic_nonlocal rhoSgl, & rhoSglMobile, & ! iRhoU rhoSglEdgeMobile, & - rhoSglEdgeMobilePos, & - rhoSglEdgeMobileNeg, & + rho_sgl_mob_edg_pos, & + rho_sgl_mob_edg_neg, & rhoSglScrewMobile, & - rhoSglScrewMobilePos, & - rhoSglScrewMobileNeg, & + rho_sgl_mob_scr_pos, & + rho_sgl_mob_scr_neg, & rhoSglImmobile, & ! iRhoB rhoSglEdgeImmobile, & - rhoSglEdgeImmobilePos, & - rhoSglEdgeImmobileNeg, & + rho_sgl_imm_edg_pos, & + rho_sgl_imm_edg_neg, & rhoSglScrewImmobile, & - rhoSglScrewImmobilePos, & - rhoSglScrewImmobileNeg, & + rho_sgl_imm_scr_pos, & + rho_sgl_imm_scr_neg, & rhoSglPos, & rhoSglMobilePos, & rhoSglImmobilePos, & @@ -196,8 +196,8 @@ module plastic_nonlocal rhoSglMobileNeg, & rhoSglImmobileNeg, & rhoDip, & ! iRhoD - rhoDipEdge, & - rhoDipScrew, & + rho_dip_edg, & + rho_dip_scr, & rhoSglScrew, & rhoSglEdge, & accumulatedshear @@ -490,25 +490,25 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' outputID = undefined_ID select case(trim(outputs(i))) case ('rho_sgl_edge_pos_mobile') - outputID = merge(rho_sgl_edge_pos_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_edg_pos_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_sgl_edge_neg_mobile') - outputID = merge(rho_sgl_edge_neg_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_edg_neg_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_sgl_screw_pos_mobile') - outputID = merge(rho_sgl_screw_pos_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_scr_pos_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_sgl_screw_neg_mobile') - outputID = merge(rho_sgl_screw_neg_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_scr_neg_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_sgl_edge_pos_immobile') - outputID = merge(rho_sgl_edge_pos_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_edg_pos_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_sgl_edge_neg_immobile') - outputID = merge(rho_sgl_edge_neg_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_edg_neg_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_sgl_screw_pos_immobile') - outputID = merge(rho_sgl_screw_pos_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_scr_pos_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_sgl_screw_neg_immobile') - outputID = merge(rho_sgl_screw_neg_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_scr_neg_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_dip_edge') - outputID = merge(rho_dip_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dip_edg_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_dip_screw') - outputID = merge(rho_dip_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dip_scr_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_forest') outputID = merge(rho_forest_ID,undefined_ID,prm%totalNslip>0_pInt) case ('shearrate') @@ -620,25 +620,25 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' dot%rhoSglEdgeMobile => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) del%rhoSglEdgeMobile => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - stt%rhoSglEdgeMobilePos => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) - dot%rhoSglEdgeMobilePos => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) - del%rhoSglEdgeMobilePos => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_edg_pos => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) + dot%rho_sgl_mob_edg_pos => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) + del%rho_sgl_mob_edg_pos => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) - stt%rhoSglEdgeMobileNeg => plasticState(p)%state (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - dot%rhoSglEdgeMobileNeg => plasticState(p)%dotState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - del%rhoSglEdgeMobileNeg => plasticState(p)%deltaState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_edg_neg => plasticState(p)%state (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + dot%rho_sgl_mob_edg_neg => plasticState(p)%dotState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + del%rho_sgl_mob_edg_neg => plasticState(p)%deltaState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) stt%rhoSglScrewMobile => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) dot%rhoSglScrewMobile => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) del%rhoSglScrewMobile => plasticState(p)%deltaState (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - stt%rhoSglScrewMobilePos => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) - dot%rhoSglScrewMobilePos => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) - del%rhoSglScrewMobilePos => plasticState(p)%deltaState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_scr_pos => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) + dot%rho_sgl_mob_scr_pos => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) + del%rho_sgl_mob_scr_pos => plasticState(p)%deltaState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) - stt%rhoSglScrewMobileNeg => plasticState(p)%state (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - dot%rhoSglScrewMobileNeg => plasticState(p)%dotState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - del%rhoSglScrewMobileNeg => plasticState(p)%deltaState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_scr_neg => plasticState(p)%state (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + dot%rho_sgl_mob_scr_neg => plasticState(p)%dotState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + del%rho_sgl_mob_scr_neg => plasticState(p)%deltaState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) stt%rhoSglImmobile => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) dot%rhoSglImmobile => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) @@ -648,37 +648,37 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' dot%rhoSglEdgeImmobile => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) del%rhoSglEdgeImmobile => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - stt%rhoSglEdgeImmobilePos => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) - dot%rhoSglEdgeImmobilePos => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) - del%rhoSglEdgeImmobilePos => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_edg_pos => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) + dot%rho_sgl_imm_edg_pos => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) + del%rho_sgl_imm_edg_pos => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) - stt%rhoSglEdgeImmobileNeg => plasticState(p)%state (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - dot%rhoSglEdgeImmobileNeg => plasticState(p)%dotState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - del%rhoSglEdgeImmobileNeg => plasticState(p)%deltaState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_edg_neg => plasticState(p)%state (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + dot%rho_sgl_imm_edg_neg => plasticState(p)%dotState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + del%rho_sgl_imm_edg_neg => plasticState(p)%deltaState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) stt%rhoSglScrewImmobile => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) dot%rhoSglScrewImmobile => plasticState(p)%dotState (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) del%rhoSglScrewImmobile => plasticState(p)%deltaState (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - stt%rhoSglScrewImmobilePos => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) - dot%rhoSglScrewImmobilePos => plasticState(p)%dotState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) - del%rhoSglScrewImmobilePos => plasticState(p)%deltaState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_scr_pos => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) + dot%rho_sgl_imm_scr_pos => plasticState(p)%dotState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) + del%rho_sgl_imm_scr_pos => plasticState(p)%deltaState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) - stt%rhoSglScrewImmobileNeg => plasticState(p)%state (7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - dot%rhoSglScrewImmobileNeg => plasticState(p)%dotState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - del%rhoSglScrewImmobileNeg => plasticState(p)%deltaState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_scr_neg => plasticState(p)%state (7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + dot%rho_sgl_imm_scr_neg => plasticState(p)%dotState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + del%rho_sgl_imm_scr_neg => plasticState(p)%deltaState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) stt%rhoDip => plasticState(p)%state (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) dot%rhoDip => plasticState(p)%dotState (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) del%rhoDip => plasticState(p)%deltaState (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - stt%rhoDipEdge => plasticState(p)%state (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) - dot%rhoDipEdge => plasticState(p)%dotState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) - del%rhoDipEdge => plasticState(p)%deltaState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) + stt%rho_dip_edg => plasticState(p)%state (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) + dot%rho_dip_edg => plasticState(p)%dotState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) + del%rho_dip_edg => plasticState(p)%deltaState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) - stt%rhoDipScrew => plasticState(p)%state (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - dot%rhoDipScrew => plasticState(p)%dotState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - del%rhoDipScrew => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + stt%rho_dip_scr => plasticState(p)%state (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + dot%rho_dip_scr => plasticState(p)%dotState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + del%rho_dip_scr => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) stt%accumulatedshear => plasticState(p)%state (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) dot%accumulatedshear => plasticState(p)%dotState (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) @@ -840,13 +840,13 @@ subroutine stateInit(phase,NofMyPhase) do s = from,upto noise = [math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter), & math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter)] - stt%rhoSglEdgeMobilePos(s,e) = prm%rhoSglEdgePos0(f) + noise(1) - stt%rhoSglEdgeMobileNeg(s,e) = prm%rhoSglEdgeNeg0(f) + noise(1) - stt%rhoSglScrewMobilePos(s,e) = prm%rhoSglScrewPos0(f) + noise(2) - stt%rhoSglScrewMobileNeg(s,e) = prm%rhoSglScrewNeg0(f) + noise(2) + stt%rho_sgl_mob_edg_pos(s,e) = prm%rhoSglEdgePos0(f) + noise(1) + stt%rho_sgl_mob_edg_neg(s,e) = prm%rhoSglEdgeNeg0(f) + noise(1) + stt%rho_sgl_mob_scr_pos(s,e) = prm%rhoSglScrewPos0(f) + noise(2) + stt%rho_sgl_mob_scr_neg(s,e) = prm%rhoSglScrewNeg0(f) + noise(2) enddo - stt%rhoDipEdge(from:upto,e) = prm%rhoDipEdge0(f) - stt%rhoDipScrew(from:upto,e) = prm%rhoDipScrew0(f) + stt%rho_dip_edg(from:upto,e) = prm%rhoDipEdge0(f) + stt%rho_dip_scr(from:upto,e) = prm%rhoDipScrew0(f) enddo enddo endif @@ -2399,44 +2399,44 @@ dUpper = max(dUpper,dLower) outputsLoop: do o = 1_pInt,size(param(instance)%outputID) select case(param(instance)%outputID(o)) - case (rho_sgl_edge_pos_mobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + case (rho_sgl_mob_edg_pos_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_edg_pos(:,of) cs = cs + ns - case (rho_sgl_edge_pos_immobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5) + case (rho_sgl_imm_edg_pos_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_edg_pos(:,of) cs = cs + ns - case (rho_sgl_edge_neg_mobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + case (rho_sgl_mob_edg_neg_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_edg_neg(:,of) cs = cs + ns - case (rho_sgl_edge_neg_immobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,6) + case (rho_sgl_imm_edg_neg_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_edg_neg(:,of) cs = cs + ns - case (rho_dip_edge_ID) - postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1) + case (rho_dip_edg_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_dip_edg(:,of) cs = cs + ns - case (rho_sgl_screw_pos_mobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + case (rho_sgl_mob_scr_pos_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_scr_pos(:,of) cs = cs + ns - case (rho_sgl_screw_pos_immobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7) + case (rho_sgl_imm_scr_pos_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_scr_pos(:,of) cs = cs + ns - case (rho_sgl_screw_neg_mobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + case (rho_sgl_mob_scr_neg_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_scr_neg(:,of) cs = cs + ns - case (rho_sgl_screw_neg_immobile_ID) - postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,8) + case (rho_sgl_imm_scr_neg_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_scr_neg(:,of) cs = cs + ns - case (rho_dip_screw_ID) - postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2) + case (rho_dip_scr_ID) + postResults(cs+1_pInt:cs+ns) = stt%rho_dip_scr(:,of) cs = cs + ns case (rho_forest_ID) From eb2646ca9c106afb203b732faa4759c8381bac59 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Mar 2019 13:13:48 +0100 Subject: [PATCH 02/19] improving readability - arrays to access specific dislocation types - function to access and clean rho --- src/plastic_nonlocal.f90 | 113 ++++++++++++++++++++++++++++++--------- 1 file changed, 88 insertions(+), 25 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 20bc9bc6d..d55b7f283 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -19,7 +19,27 @@ module plastic_nonlocal character(len=64), dimension(:,:), allocatable, target, public :: & plastic_nonlocal_output !< name of each post result output - + + integer, dimension(8), parameter :: & + sgl = [1,2,3,4,5,6,7,8] + integer, dimension(2), parameter :: & + dip = [9,10] + integer, dimension(5), parameter :: & + edg = [1,2,5,6,9], & + scr = [3,4,7,8,10] + integer, dimension(4), parameter :: & + mob = [1,2,3,4], & + imm = [5,6,7,8], & + pos = sgl(1:7:2), & + neg = sgl(2:8:2), & + sgl_edg = edg(1:4), & + sgl_scr = scr(1:4) + integer, parameter :: & + mob_edg_pos = 1, & + mob_edg_neg = 2, & + mob_scr_pos = 3, & + mob_scr_neg = 4 + integer(pInt), dimension(:,:), allocatable, private :: & iRhoF !< state indices for forest density integer(pInt), dimension(:,:,:), allocatable, private :: & @@ -200,6 +220,7 @@ module plastic_nonlocal rho_dip_scr, & rhoSglScrew, & rhoSglEdge, & + rho_forest, & accumulatedshear end type tNonlocalState @@ -686,6 +707,8 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' plasticState(p)%aTolState(10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ) = prm%aTolShear plasticState(p)%slipRate => plasticState(p)%dotState(10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) plasticState(p)%accumulatedSlip => plasticState(p)%state (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) + + stt%rho_forest => plasticState(p)%state (11_pInt*prm%totalNslip + 1_pInt:12_pInt*prm%totalNslip ,1:NofMyPhase) allocate(dst%tau_Threshold(prm%totalNslip,NofMyPhase),source=0.0_pReal) @@ -742,7 +765,9 @@ allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPn iRhoD(s,c,phase_plasticityInstance(p)) = l enddo enddo - l = l + param(phase_plasticityInstance(p))%totalNslip + + l = l + param(phase_plasticityInstance(p))%totalNslip ! shear(rates) + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt iRhoF(s,phase_plasticityInstance(p)) = l @@ -925,15 +950,12 @@ integer(pInt) ns, neighbor_el, & ! element numb nRealNeighbors ! number of really existing neighbors integer(pInt), dimension(2) :: neighbors real(pReal) FVsize, & - correction, & - myRhoForest + correction real(pReal), dimension(2) :: rhoExcessGradient, & rhoExcessGradient_over_rho, & rhoTotal real(pReal), dimension(3) :: rhoExcessDifferences, & normal_latticeConf -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & - rhoForest ! forest dislocation density real(pReal), dimension(3,3) :: invFe, & ! inverse of elastic deformation gradient invFp, & ! inverse of plastic deformation gradient connections, & @@ -942,6 +964,12 @@ real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & connection_latticeConf real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoExcess +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + rho_edg_delta, & + rho_scr_delta +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + rho, & + rho_neighbor real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip ! dipole dislocation density (edge, screw) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & @@ -949,6 +977,12 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix + +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),theMesh%elem%nIPneighbors) :: & + rho_edg_delta_neighbor, & + rho_scr_delta_neighbor, & + rho_edg_sum_neighbor, & + rho_scr_sum_neighbor real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point @@ -958,7 +992,7 @@ real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pI ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) -associate(prm => param(instance),dst => microstructure(instance)) +associate(prm => param(instance),dst => microstructure(instance), stt => state(instance)) ns = prm%totalNslip @@ -977,14 +1011,10 @@ where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & .or. abs(rhoDip) < prm%significantRho) & rhoDip = 0.0_pReal -!*** calculate the forest dislocation density -!*** (= projection of screw and edge dislocations) +rho = getRho(instance,of,ip,el) -forall (s = 1_pInt:ns) & - rhoForest(s) = dot_product((sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1)), & - prm%forestProjection_Edge(s,1:ns)) & - + dot_product((sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2)), & - prm%forestProjection_Screw(s,1:ns)) +stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) !*** calculate the threshold shear stress for dislocation slip @@ -992,11 +1022,10 @@ forall (s = 1_pInt:ns) & !*** (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals) if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc - do s = 1_pInt,ns - myRhoForest = max(rhoForest(s),prm%significantRho) + do s = 1_pInt,ns correction = ( 1.0_pReal - prm%linetensionEffect & + prm%linetensionEffect & - * log(0.35_pReal * prm%burgers(s) * sqrt(myRhoForest)) & + * log(0.35_pReal * prm%burgers(s) * sqrt(max(stt%rho_forest(s,of),prm%significantRho))) & / log(0.35_pReal * prm%burgers(s) * 1e6_pReal)) ** 2.0_pReal myInteractionMatrix(1:ns,s) = correction * prm%interactionSlipSlip(1:ns,s) enddo @@ -1023,8 +1052,13 @@ forall (s = 1_pInt:ns) & if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then invFe = math_inv33(Fe) invFp = math_inv33(Fp) - rhoExcess(1,1:ns) = rhoSgl(1:ns,1) - rhoSgl(1:ns,2) - rhoExcess(2,1:ns) = rhoSgl(1:ns,3) - rhoSgl(1:ns,4) + + rho_edg_delta = rho(:,mob_edg_pos) - rho(:,mob_edg_neg) + rho_scr_delta = rho(:,mob_scr_pos) - rho(:,mob_scr_neg) + + rhoExcess(1,1:ns) = rho_edg_delta + rhoExcess(2,1:ns) = rho_scr_delta + FVsize = mesh_ipVolume(ip,el) ** (1.0_pReal/3.0_pReal) !* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities @@ -1038,8 +1072,14 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then no = phasememberAt(1,neighbor_ip,neighbor_el) if (neighbor_el > 0 .and. neighbor_ip > 0) then neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) - if (neighbor_instance == instance) then ! same instance should be same structure + if (neighbor_instance == instance) then + nRealNeighbors = nRealNeighbors + 1_pInt + rho_neighbor = getRho(instance,no,neighbor_ip,neighbor_el) + + rho_edg_delta_neighbor(:,n) = rho_neighbor(:,mob_edg_pos) - rho_neighbor(:,mob_edg_neg) + rho_scr_delta_neighbor(:,n) = rho_neighbor(:,mob_scr_pos) - rho_neighbor(:,mob_scr_neg) + forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) neighbor_rhoExcess(c,s,n) = & @@ -1064,11 +1104,15 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then ! local neighbor or different lattice structure or different constitution instance -> use central values instead connection_latticeConf(1:3,n) = 0.0_pReal neighbor_rhoExcess(1:2,1:ns,n) = rhoExcess + rho_edg_delta_neighbor(:,n) = rho_scr_delta + rho_scr_delta_neighbor(:,n) = rho_scr_delta endif else ! free surface -> use central values instead connection_latticeConf(1:3,n) = 0.0_pReal neighbor_rhoExcess(1:2,1:ns,n) = rhoExcess + rho_edg_delta_neighbor(:,n) = rho_scr_delta + rho_scr_delta_neighbor(:,n) = rho_scr_delta endif enddo @@ -1121,16 +1165,12 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then enddo endif - -!*** set dependent states -plasticState(ph)%state(iRhoF(1:ns,instance),of) = rhoForest - #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip - write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', rhoForest + write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', stt%rho_forest(:,of) write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_threshold(:,of)*1e-6 write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', dst%tau_back(:,of)*1e-6 endif @@ -2564,6 +2604,29 @@ end associate end function plastic_nonlocal_postResults +function getRho(instance,of,ip,el) + use mesh + + implicit none + integer, intent(in) :: instance, of,ip,el + real(pReal), dimension(param(instance)%totalNslip,10) :: getRho + + associate(prm => param(instance)) + + getRho = reshape(state(instance)%rho(:,of),[prm%totalNslip,10]) + + ! ensure mobile densities (not for imm, they have a sign) + getRho(:,mob) = max(getRho(:,mob),0.0_pReal) + getRho(:,dip) = max(getRho(:,dip),0.0_pReal) + + where (abs(getRho) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(getRho) < prm%significantRho) & + getRho = 0.0_pReal + + end associate +end function getRho + + !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- From 5da017e79f5c495071c250df22267a2267ffc914 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Mar 2019 15:08:50 +0100 Subject: [PATCH 03/19] using new funtionality to get rho --- src/plastic_nonlocal.f90 | 55 ++++++++++------------------------------ 1 file changed, 13 insertions(+), 42 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index d55b7f283..7225afbff 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -996,22 +996,9 @@ associate(prm => param(instance),dst => microstructure(instance), stt => state(i ns = prm%totalNslip -!*** get basic states -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) -endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & - rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities - -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & - .or. abs(rhoSgl) < prm%significantRho) & - rhoSgl = 0.0_pReal -where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & - .or. abs(rhoDip) < prm%significantRho) & - rhoDip = 0.0_pReal - rho = getRho(instance,of,ip,el) +rhoSgl = rho(:,sgl) +rhoDip = rho(:,dip) stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) @@ -1355,7 +1342,9 @@ integer(pInt) instance, & t, & !< dislocation type s !< index of my current slip system real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & - rhoSgl !< single dislocation densities (including blocked) + rhoSgl !< single dislocation densities (including blocked) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),10) :: & + rho real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & v, & !< velocity tauNS, & !< resolved shear stress including non Schmid and backstress terms @@ -1374,20 +1363,12 @@ associate(prm => param(instance),dst=>microstructure(instance)) ns = prm%totalNslip !*** shortcut to state variables - - -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) -endforall -where (abs(rhoSgl) * volume ** 0.667_pReal < prm%significantN & - .or. abs(rhoSgl) < prm%significantRho) & - rhoSgl = 0.0_pReal +rho = getRho(instance,of,ip,el) +rhoSgl = rho(:,sgl) !*** get resolved shear stress !*** for screws possible non-schmid contributions are also taken into account - do s = 1_pInt,ns tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) tauNS(s,1) = tau(s) @@ -1505,6 +1486,8 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e deltaRho, & ! density increment deltaRhoRemobilization, & ! density increment by remobilization deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + rho ! current dislocation densities real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & rhoSgl ! current single dislocation densities (positive/negative screw and edge without dipoles) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & @@ -1530,33 +1513,21 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst => microstructure(instance)) ns = totalNslip(instance) - - + !*** shortcut to state variables - forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) endforall - -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & - .or. abs(rhoSgl) < prm%significantRho) & - rhoSgl = 0.0_pReal -where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & - .or. abs(rhoDip) < prm%significantRho) & - rhoDip = 0.0_pReal - - + rho = getRho(instance,of,ip,el) + rhoSgl = rho(:,sgl) + rhoDip = rho(:,dip) !**************************************************************************** !*** dislocation remobilization (bauschinger effect) - deltaRhoRemobilization = 0.0_pReal do t = 1_pInt,4_pInt do s = 1_pInt,ns From 117f4b9625516d3fadacd7ac176202cbdedc5c4d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Mar 2019 15:46:39 +0100 Subject: [PATCH 04/19] more functions relying on getRho --- src/plastic_nonlocal.f90 | 44 ++++++++++++++-------------------------- 1 file changed, 15 insertions(+), 29 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 7225afbff..dde9538fe 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -1021,7 +1021,7 @@ else endif forall (s = 1_pInt:ns) & dst%tau_threshold(s,of) = prm%mu * prm%burgers(s) & - * sqrt(dot_product((sum(abs(rhoSgl),2) + sum(abs(rhoDip),2)), myInteractionMatrix(1:ns,s))) + * sqrt(dot_product(sum(abs(rho),2), myInteractionMatrix(1:ns,s))) !*** calculate the dislocation stress of the neighboring excess dislocation densities @@ -1697,6 +1697,7 @@ integer(pInt) :: ph, & topp, & !< type of dislocation with opposite sign to t s !< index of my current slip system real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),10) :: & + rho, & rhoDot, & !< density evolution rhoDotMultiplication, & !< density evolution by multiplication rhoDotFlux, & !< density evolution by flux @@ -1705,7 +1706,6 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt rhoDotThermalAnnihilation !< density evolution by thermal annihilation real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) - rhoSglOriginal, & neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & @@ -1714,13 +1714,11 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt neighbor_v, & !< dislocation glide velocity of enighboring ip gdot !< shear rates real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & - rhoForest, & !< forest dislocation density tau, & !< current resolved shear stress vClimb !< climb velocity of edge dipoles real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) - rhoDipOriginal, & dLower, & !< minimum stable dipole distance for edges and screws dUpper !< current maximum stable dipole distance for edges and screws real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & @@ -1746,7 +1744,7 @@ logical considerEnteringFlux, & p = phaseAt(1,ip,el) o = phasememberAt(1,ip,el) -if (timestep <= 0.0_pReal) then ! if illegal timestep... Why here and not on function entry?? +if (timestep <= 0.0_pReal) then ! if illegal timestep... plasticState(p)%dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) return endif @@ -1760,31 +1758,19 @@ endif ph = material_phase(1_pInt,ip,el) instance = phase_plasticityInstance(ph) -associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance)) +associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance),stt => state(instance)) ns = totalNslip(instance) tau = 0.0_pReal gdot = 0.0_pReal +rho = getRho(instance,o,ip,el) +rhoSgl = rho(:,sgl) +rhoDip = rho(:,dip) forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) v(s,t) = plasticState(p)%state(iV (s,t,instance),o) endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(plasticState(p)%state(iRhoD(s,c,instance),o), 0.0_pReal) ! ensure positive dipole densities -endforall -rhoForest = plasticState(p)%state(iRhoF(1:ns,instance),o) - -rhoSglOriginal = rhoSgl -rhoDipOriginal = rhoDip -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & - .or. abs(rhoSgl) < prm%significantRho) & - rhoSgl = 0.0_pReal -where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & - .or. abs(rhoDip) < prm%significantRho) & - rhoDip = 0.0_pReal !**************************************************************************** @@ -1832,17 +1818,17 @@ rhoDotMultiplication = 0.0_pReal if (lattice_structure(ph) == LATTICE_bcc_ID) then ! BCC forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(rhoForest(s)) / prm%lambda0(s) ! & ! mean free path + * sqrt(stt%rho_forest(s,o)) / prm%lambda0(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) /prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(rhoForest(s)) / prm%lambda0(s) ! & ! mean free path + * sqrt(stt%rho_forest(s,o)) / prm%lambda0(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation endforall else ! ALL OTHER STRUCTURES rhoDotMultiplication(1:ns,1:4) = spread( & (sum(abs(gdot(1:ns,1:2)),2) * prm%fEdgeMultiplication + sum(abs(gdot(1:ns,3:4)),2)) & - * sqrt(rhoForest(1:ns)) / prm%lambda0 / prm%burgers(1:ns), 2, 4) + * sqrt(stt%rho_forest(:,o)) / prm%lambda0 / prm%burgers(1:ns), 2, 4) endif @@ -2062,7 +2048,7 @@ forall (c=1_pInt:2_pInt) & if (lattice_structure(ph) == LATTICE_fcc_ID) & ! only fcc forall (s = 1:ns, prm%colinearSystem(s) > 0_pInt) & rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & - * 0.25_pReal * sqrt(rhoForest(s)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor + * 0.25_pReal * sqrt(stt%rho_forest(s,o)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor @@ -2116,15 +2102,15 @@ results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> total density change', & rhoDot * timestep write(6,'(a,/,10(12x,12(f12.5,1x),/))') '<< CONST >> relative density change', & - rhoDot(1:ns,1:8) * timestep / (abs(rhoSglOriginal)+1.0e-10), & - rhoDot(1:ns,9:10) * timestep / (rhoDipOriginal+1.0e-10) + rhoDot(1:ns,1:8) * timestep / (abs(stt%rho(:,sgl))+1.0e-10), & + rhoDot(1:ns,9:10) * timestep / (stt%rho(:,dip)+1.0e-10) write(6,*) endif #endif -if ( any(rhoSglOriginal(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & - .or. any(rhoDipOriginal(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then +if ( any(stt%rho(:,mob) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & + .or. any(stt%rho(:,dip) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip From f079e6f9c0888e06fbba25e051a3f357c05dfc89 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Mar 2019 16:29:16 +0100 Subject: [PATCH 05/19] simpler logic for shortrange stress correction --- src/plastic_nonlocal.f90 | 49 +++++++++++++--------------------------- 1 file changed, 16 insertions(+), 33 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index dde9538fe..f72881dd6 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -916,7 +916,6 @@ use mesh, only: & use material, only: & material_phase, & phase_localPlasticity, & - plasticState, & phaseAt, phasememberAt, & phase_plasticityInstance use lattice, only: & @@ -935,7 +934,6 @@ real(pReal), dimension(3,3), intent(in) :: & integer(pInt) :: & ph, & !< phase of, & !< offset - np, & !< neighbor phase no !< nieghbor offset integer(pInt) ns, neighbor_el, & ! element number of neighboring material point @@ -970,8 +968,6 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & rho, & rho_neighbor -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & - rhoDip ! dipole dislocation density (edge, screw) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & @@ -998,7 +994,6 @@ ns = prm%totalNslip rho = getRho(instance,of,ip,el) rhoSgl = rho(:,sgl) -rhoDip = rho(:,dip) stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) @@ -1050,36 +1045,25 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then !* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities - nRealNeighbors = 0_pInt + nRealNeighbors = 0 neighbor_rhoTotal = 0.0_pReal do n = 1_pInt,theMesh%elem%nIPneighbors neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) - np = phaseAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el) if (neighbor_el > 0 .and. neighbor_ip > 0) then neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) if (neighbor_instance == instance) then - nRealNeighbors = nRealNeighbors + 1_pInt + nRealNeighbors = nRealNeighbors + 1 rho_neighbor = getRho(instance,no,neighbor_ip,neighbor_el) rho_edg_delta_neighbor(:,n) = rho_neighbor(:,mob_edg_pos) - rho_neighbor(:,mob_edg_neg) rho_scr_delta_neighbor(:,n) = rho_neighbor(:,mob_scr_pos) - rho_neighbor(:,mob_scr_neg) - forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) + neighbor_rhoTotal(1,:,n) = sum(abs(rho_neighbor(:,edg)),2) + neighbor_rhoTotal(2,:,n) = sum(abs(rho_neighbor(:,scr)),2) - neighbor_rhoExcess(c,s,n) = & - max(plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no), 0.0_pReal) & ! positive mobiles - - max(plasticState(np)%state(iRhoU(s,2*c,neighbor_instance), no), 0.0_pReal) ! negative mobiles - neighbor_rhoTotal(c,s,n) = & - max(plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no), 0.0_pReal) & ! positive mobiles - + max(plasticState(np)%state(iRhoU(s,2*c,neighbor_instance), no), 0.0_pReal) & ! negative mobiles - + abs(plasticState(np)%state(iRhoB(s,2*c-1,neighbor_instance),no)) & ! positive deads - + abs(plasticState(np)%state(iRhoB(s,2*c,neighbor_instance), no)) & ! negative deads - + max(plasticState(np)%state(iRhoD(s,c,neighbor_instance), no), 0.0_pReal) ! dipoles - - endforall connection_latticeConf(1:3,n) = & math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & - mesh_ipCoordinates(1:3,ip,el)) @@ -1090,19 +1074,19 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then else ! local neighbor or different lattice structure or different constitution instance -> use central values instead connection_latticeConf(1:3,n) = 0.0_pReal - neighbor_rhoExcess(1:2,1:ns,n) = rhoExcess - rho_edg_delta_neighbor(:,n) = rho_scr_delta + rho_edg_delta_neighbor(:,n) = rho_edg_delta rho_scr_delta_neighbor(:,n) = rho_scr_delta endif else ! free surface -> use central values instead connection_latticeConf(1:3,n) = 0.0_pReal - neighbor_rhoExcess(1:2,1:ns,n) = rhoExcess - rho_edg_delta_neighbor(:,n) = rho_scr_delta + rho_edg_delta_neighbor(:,n) = rho_edg_delta rho_scr_delta_neighbor(:,n) = rho_scr_delta endif enddo + neighbor_rhoExcess(1,:,:) = rho_edg_delta_neighbor + neighbor_rhoExcess(2,:,:) = rho_scr_delta_neighbor !* loop through the slip systems and calculate the dislocation gradient by !* 1. interpolation of the excess density in the neighorhood @@ -1124,10 +1108,9 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then - neighbor_rhoExcess(c,s,neighbors(2)) enddo invConnections = math_inv33(connections) - if (all(dEq0(invConnections))) & - call IO_error(-1_pInt,ext_msg='back stress calculation: inversion error') - rhoExcessGradient(c) = math_mul3x3(m(1:3,s,c), & - math_mul33x3(invConnections,rhoExcessDifferences)) + if (all(dEq0(invConnections))) call IO_error(-1_pInt,ext_msg='back stress calculation: inversion error') + + rhoExcessGradient(c) = math_mul3x3(m(1:3,s,c), math_mul33x3(invConnections,rhoExcessDifferences)) enddo ! ... plus gradient from deads ... @@ -1137,12 +1120,12 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then enddo ! ... normalized with the total density ... + rhoTotal(1) = (sum(abs(rho(s,edg))) + sum(neighbor_rhoTotal(1,s,:))) / real(1_pInt + nRealNeighbors,pReal) + rhoTotal(2) = (sum(abs(rho(s,scr))) + sum(neighbor_rhoTotal(2,s,:))) / real(1_pInt + nRealNeighbors,pReal) + rhoExcessGradient_over_rho = 0.0_pReal - forall (c = 1_pInt:2_pInt) & - rhoTotal(c) = (sum(abs(rhoSgl(s,[2*c-1,2*c,2*c+3,2*c+4]))) + rhoDip(s,c) & - + sum(neighbor_rhoTotal(c,s,:))) / real(1_pInt + nRealNeighbors,pReal) - forall (c = 1_pInt:2_pInt, rhoTotal(c) > 0.0_pReal) & - rhoExcessGradient_over_rho(c) = rhoExcessGradient(c) / rhoTotal(c) + where(rhoTotal > 0.0_pReal) & + rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal ! ... gives the local stress correction when multiplied with a factor dst%tau_back(s,of) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & From 8f89827573eb8be75822aac9aef54f617ef6f990 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Mar 2019 19:09:22 +0100 Subject: [PATCH 06/19] improved readability --- src/plastic_nonlocal.f90 | 53 +++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index f72881dd6..f873b69fe 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -22,8 +22,6 @@ module plastic_nonlocal integer, dimension(8), parameter :: & sgl = [1,2,3,4,5,6,7,8] - integer, dimension(2), parameter :: & - dip = [9,10] integer, dimension(5), parameter :: & edg = [1,2,5,6,9], & scr = [3,4,7,8,10] @@ -39,6 +37,10 @@ module plastic_nonlocal mob_edg_neg = 2, & mob_scr_pos = 3, & mob_scr_neg = 4 + integer, dimension(2), parameter :: & + dip = [9,10], & + imm_edg = imm(1:2), & + imm_scr = imm(3:4) integer(pInt), dimension(:,:), allocatable, private :: & iRhoF !< state indices for forest density @@ -444,7 +446,7 @@ subroutine plastic_nonlocal_init ! ToDo: discuss logic prm%rhoSglScatter = config%getFloat('rhosglscatter') prm%rhoSglRandom = config%getFloat('rhosglrandom',0.0_pReal) - if (config%keyExists('rhosglrandom')) & + if (config%keyExists('/rhosglrandom/')) & prm%rhoSglRandomBinning = config%getFloat('rhosglrandombinning',0.0_pReal) !ToDo: useful default? ! if (rhoSglRandom(instance) < 0.0_pReal) & ! if (rhoSglRandomBinning(instance) <= 0.0_pReal) & @@ -452,7 +454,7 @@ subroutine plastic_nonlocal_init prm%surfaceTransmissivity = config%getFloat('surfacetransmissivity',defaultVal=1.0_pReal) prm%grainboundaryTransmissivity = config%getFloat('grainboundarytransmissivity',defaultVal=-1.0_pReal) prm%fEdgeMultiplication = config%getFloat('edgemultiplication') - prm%shortRangeStressCorrection = config%getInt('shortrangestresscorrection',defaultVal=0_pInt ) > 0_pInt ! ToDo: use /flag/ type key + prm%shortRangeStressCorrection = config%keyExists('/shortrangestresscorrection/') !-------------------------------------------------------------------------------------------------- ! sanity checks @@ -942,7 +944,6 @@ integer(pInt) ns, neighbor_el, & ! element numb neighbor_instance, & ! instance of this plasticity of neighboring material point c, & ! index of dilsocation character (edge, screw) s, & ! slip system index - t, & ! index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) dir, & n, & nRealNeighbors ! number of really existing neighbors @@ -968,8 +969,6 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & rho, & rho_neighbor -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & - rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix @@ -993,7 +992,6 @@ associate(prm => param(instance),dst => microstructure(instance), stt => state(i ns = prm%totalNslip rho = getRho(instance,of,ip,el) -rhoSgl = rho(:,sgl) stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) @@ -1114,14 +1112,12 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then enddo ! ... plus gradient from deads ... - do t = 1_pInt,4_pInt - c = (t - 1_pInt) / 2_pInt + 1_pInt - rhoExcessGradient(c) = rhoExcessGradient(c) + rhoSgl(s,t+4_pInt) / FVsize - enddo + rhoExcessGradient(1) = rhoExcessGradient(1) + sum(rho(s,imm_edg)) / FVsize + rhoExcessGradient(2) = rhoExcessGradient(2) + sum(rho(s,imm_scr)) / FVsize ! ... normalized with the total density ... - rhoTotal(1) = (sum(abs(rho(s,edg))) + sum(neighbor_rhoTotal(1,s,:))) / real(1_pInt + nRealNeighbors,pReal) - rhoTotal(2) = (sum(abs(rho(s,scr))) + sum(neighbor_rhoTotal(2,s,:))) / real(1_pInt + nRealNeighbors,pReal) + rhoTotal(1) = (sum(abs(rho(s,edg))) + sum(neighbor_rhoTotal(1,s,:))) / real(1 + nRealNeighbors,pReal) + rhoTotal(2) = (sum(abs(rho(s,scr))) + sum(neighbor_rhoTotal(2,s,:))) / real(1 + nRealNeighbors,pReal) rhoExcessGradient_over_rho = 0.0_pReal where(rhoTotal > 0.0_pReal) & @@ -1129,8 +1125,7 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then ! ... gives the local stress correction when multiplied with a factor dst%tau_back(s,of) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & - * (rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) & - + rhoExcessGradient_over_rho(2)) + * (rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) + rhoExcessGradient_over_rho(2)) enddo endif @@ -1504,25 +1499,23 @@ endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) endforall - rho = getRho(instance,of,ip,el) - rhoSgl = rho(:,sgl) - rhoDip = rho(:,dip) + rho = getRho(instance,of,ip,el) + rhoDip = rho(:,dip) !**************************************************************************** !*** dislocation remobilization (bauschinger effect) -deltaRhoRemobilization = 0.0_pReal -do t = 1_pInt,4_pInt - do s = 1_pInt,ns - if (rhoSgl(s,t+4_pInt) * v(s,t) < 0.0_pReal) then - deltaRhoRemobilization(s,t) = abs(rhoSgl(s,t+4_pInt)) - rhoSgl(s,t) = rhoSgl(s,t) + abs(rhoSgl(s,t+4_pInt)) - deltaRhoRemobilization(s,t+4_pInt) = - rhoSgl(s,t+4_pInt) - rhoSgl(s,t+4_pInt) = 0.0_pReal - endif - enddo -enddo +where(rho(:,imm) * v < 0.0_pReal) + deltaRhoRemobilization(:,mob) = abs(rho(:,imm)) + deltaRhoRemobilization(:,imm) = - rho(:,imm) + rho(:,mob) = rho(:,mob) + abs(rho(:,imm)) + rho(:,imm) = 0.0_pReal +elsewhere + deltaRhoRemobilization(:,mob) = 0.0_pReal + deltaRhoRemobilization(:,imm) = 0.0_pReal +endwhere +rhoSgl = rho(:,sgl) !**************************************************************************** From 730e7d96c050d5465b0afe0f47f9ab86a50821d5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Mar 2019 21:58:30 +0100 Subject: [PATCH 07/19] better readable --- src/plastic_nonlocal.f90 | 124 +++++++++++---------------------------- 1 file changed, 33 insertions(+), 91 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index f873b69fe..296276d9f 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -198,17 +198,13 @@ module plastic_nonlocal rho, & ! < all dislocations rhoSgl, & rhoSglMobile, & ! iRhoU - rhoSglEdgeMobile, & rho_sgl_mob_edg_pos, & rho_sgl_mob_edg_neg, & - rhoSglScrewMobile, & rho_sgl_mob_scr_pos, & rho_sgl_mob_scr_neg, & rhoSglImmobile, & ! iRhoB - rhoSglEdgeImmobile, & rho_sgl_imm_edg_pos, & rho_sgl_imm_edg_neg, & - rhoSglScrewImmobile, & rho_sgl_imm_scr_pos, & rho_sgl_imm_scr_neg, & rhoSglPos, & @@ -638,10 +634,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' stt%rhoSglMobile => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) dot%rhoSglMobile => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) del%rhoSglMobile => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - - stt%rhoSglEdgeMobile => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - dot%rhoSglEdgeMobile => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - del%rhoSglEdgeMobile => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) stt%rho_sgl_mob_edg_pos => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) dot%rho_sgl_mob_edg_pos => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) @@ -650,10 +642,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' stt%rho_sgl_mob_edg_neg => plasticState(p)%state (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) dot%rho_sgl_mob_edg_neg => plasticState(p)%dotState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) del%rho_sgl_mob_edg_neg => plasticState(p)%deltaState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - - stt%rhoSglScrewMobile => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - dot%rhoSglScrewMobile => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - del%rhoSglScrewMobile => plasticState(p)%deltaState (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) stt%rho_sgl_mob_scr_pos => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) dot%rho_sgl_mob_scr_pos => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) @@ -666,10 +654,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' stt%rhoSglImmobile => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) dot%rhoSglImmobile => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) del%rhoSglImmobile => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - - stt%rhoSglEdgeImmobile => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - dot%rhoSglEdgeImmobile => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - del%rhoSglEdgeImmobile => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) stt%rho_sgl_imm_edg_pos => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) dot%rho_sgl_imm_edg_pos => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) @@ -679,10 +663,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' dot%rho_sgl_imm_edg_neg => plasticState(p)%dotState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) del%rho_sgl_imm_edg_neg => plasticState(p)%deltaState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - stt%rhoSglScrewImmobile => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - dot%rhoSglScrewImmobile => plasticState(p)%dotState (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - del%rhoSglScrewImmobile => plasticState(p)%deltaState (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - stt%rho_sgl_imm_scr_pos => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) dot%rho_sgl_imm_scr_pos => plasticState(p)%dotState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) del%rho_sgl_imm_scr_pos => plasticState(p)%deltaState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) @@ -809,10 +789,10 @@ subroutine stateInit(phase,NofMyPhase) phasememberAt implicit none - integer(pInt),intent(in) ::& + integer,intent(in) ::& phase, & NofMyPhase - integer(pInt) :: & + integer :: & e, & i, & f, & @@ -840,8 +820,8 @@ subroutine stateInit(phase,NofMyPhase) if (prm%rhoSglRandom > 0.0_pReal) then ! get the total volume of the instance - do e = 1_pInt,theMesh%nElems - do i = 1_pInt,theMesh%elem%nIPs + do e = 1,theMesh%nElems + do i = 1,theMesh%elem%nIPs if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = mesh_ipVolume(i,e) enddo enddo @@ -860,20 +840,20 @@ subroutine stateInit(phase,NofMyPhase) enddo ! homogeneous distribution of density with some noise else - do e = 1_pInt, NofMyPhase - do f = 1_pInt,size(prm%Nslip,1) - from = 1_pInt + sum(prm%Nslip(1:f-1_pInt)) + do e = 1, NofMyPhase + do f = 1,size(prm%Nslip,1) + from = 1 + sum(prm%Nslip(1:f-1)) upto = sum(prm%Nslip(1:f)) do s = from,upto noise = [math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter), & math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter)] - stt%rho_sgl_mob_edg_pos(s,e) = prm%rhoSglEdgePos0(f) + noise(1) - stt%rho_sgl_mob_edg_neg(s,e) = prm%rhoSglEdgeNeg0(f) + noise(1) + stt%rho_sgl_mob_edg_pos(s,e) = prm%rhoSglEdgePos0(f) + noise(1) + stt%rho_sgl_mob_edg_neg(s,e) = prm%rhoSglEdgeNeg0(f) + noise(1) stt%rho_sgl_mob_scr_pos(s,e) = prm%rhoSglScrewPos0(f) + noise(2) stt%rho_sgl_mob_scr_neg(s,e) = prm%rhoSglScrewNeg0(f) + noise(2) enddo - stt%rho_dip_edg(from:upto,e) = prm%rhoDipEdge0(f) - stt%rho_dip_scr(from:upto,e) = prm%rhoDipScrew0(f) + stt%rho_dip_edg(from:upto,e) = prm%rhoDipEdge0(f) + stt%rho_dip_scr(from:upto,e) = prm%rhoDipScrew0(f) enddo enddo endif @@ -1430,6 +1410,7 @@ end subroutine plastic_nonlocal_LpAndItsTangent subroutine plastic_nonlocal_deltaState(Mp,ip,el) use prec, only: & dNeq0 +#ifdef DEBUG use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & @@ -1437,6 +1418,7 @@ use debug, only: debug_level, & debug_levelSelective, & debug_i, & debug_e +#endif use math, only: PI, & math_mul33xx33 use mesh, only: mesh_ipVolume @@ -1466,8 +1448,6 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & rho ! current dislocation densities -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & - rhoSgl ! current single dislocation densities (positive/negative screw and edge without dipoles) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & v ! dislocation glide velocity real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & @@ -1479,17 +1459,10 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e dUpperOld, & ! old maximum stable dipole distance for edges and screws deltaDUpper ! change in maximum stable dipole distance for edges and screws -#ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & - write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_deltaState at el ip ',el,ip -#endif - ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) - associate(prm => param(instance),dst => microstructure(instance)) + associate(prm => param(instance),dst => microstructure(instance),del => deltaState(instance)) ns = totalNslip(instance) !*** shortcut to state variables @@ -1514,9 +1487,7 @@ elsewhere deltaRhoRemobilization(:,mob) = 0.0_pReal deltaRhoRemobilization(:,imm) = 0.0_pReal endwhere - -rhoSgl = rho(:,sgl) - +deltaRhoRemobilization(:,dip) = 0.0_pReal !**************************************************************************** !*** calculate dipole formation and dissociation by stress change @@ -1527,19 +1498,18 @@ do s = 1_pInt,prm%totalNslip tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,of) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo -dLower = prm%minDipoleHeight(1:ns,1:2) -dUpper(1:ns,1) = prm%mu * prm%burgers & - / (8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) -dUpper(1:ns,2) = prm%mu * prm%burgers / (4.0_pReal * PI * abs(tau)) +dLower = prm%minDipoleHeight + +dUpper(1:ns,1) = prm%mu * prm%burgers/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) +dUpper(1:ns,2) = prm%mu * prm%burgers/(4.0_pReal * PI * abs(tau)) + +where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) & + dUpper(1:ns,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(1:ns,1)) + +where(dNeq0(sqrt(sum(abs(rho(:,scr)),2)))) & + dUpper(1:ns,2) = min(1.0_pReal/sqrt(sum(abs(rho(:,scr)),2)),dUpper(1:ns,2)) -do c = 1, 2 - where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& - +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & - dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & - + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & - dUpper(1:ns,c)) -enddo dUpper = max(dUpper,dLower) deltaDUpper = dUpper - dUpperOld @@ -1557,25 +1527,11 @@ forall (t=1_pInt:4_pInt) & !*** store new maximum dipole height in state - forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) - - -!**************************************************************************** -!*** assign the changes in the dislocation densities to deltaState - -deltaRho = deltaRhoRemobilization & - + deltaRhoDipole2SingleStress plasticState(ph)%deltaState(:,of) = 0.0_pReal -forall (s = 1:ns, t = 1_pInt:4_pInt) - plasticState(ph)%deltaState(iRhoU(s,t,instance),of)= deltaRho(s,t) - plasticState(ph)%deltaState(iRhoB(s,t,instance),of) = deltaRho(s,t+4_pInt) -endforall -forall (s = 1:ns, c = 1_pInt:2_pInt) & - plasticState(ph)%deltaState(iRhoD(s,c,instance),of) = deltaRho(s,c+8_pInt) - +del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & @@ -1725,13 +1681,6 @@ if (timestep <= 0.0_pReal) then return endif -#ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & - write(6,'(/,a,i8,1x,i2,/)') '<< CONST >> nonlocal_dotState at el ip ',el,ip -#endif - ph = material_phase(1_pInt,ip,el) instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance),stt => state(instance)) @@ -1745,7 +1694,7 @@ rhoSgl = rho(:,sgl) rhoDip = rho(:,dip) forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - v(s,t) = plasticState(p)%state(iV (s,t,instance),o) + v(s,t) = plasticState(p)%state(iV (s,t,instance),o) endforall @@ -1775,10 +1724,8 @@ do s = 1_pInt,ns ! loop over slip systems enddo dLower = prm%minDipoleHeight(1:ns,1:2) -dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & - / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) -dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & - / (4.0_pReal * pi * abs(tau)) +dUpper(1:ns,1) = prm%mu * prm%burgers/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) +dUpper(1:ns,2) = prm%mu * prm%burgers/(4.0_pReal * PI * abs(tau)) do c = 1, 2 where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & @@ -1942,11 +1889,6 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then endif if (considerLeavingFlux) then - - !* timeSyncing mode: If the central ip has zero subfraction, always use "state0". This is needed in case of - !* a synchronization step for the central ip, because then "state" contains the values at the end of the - !* previously converged full time step. Also, if either me or my neighbor has zero subfraction, we have to - !* use "state0" to make sure that fluxes on both sides of the (potential) timestep are equal. my_rhoSgl = rhoSgl my_v = v @@ -2021,7 +1963,8 @@ forall (c=1_pInt:2_pInt) & + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent ! annihilated screw dipoles leave edge jogs behind on the colinear system -if (lattice_structure(ph) == LATTICE_fcc_ID) & ! only fcc + +if (lattice_structure(ph) == LATTICE_fcc_ID) & forall (s = 1:ns, prm%colinearSystem(s) > 0_pInt) & rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & * 0.25_pReal * sqrt(stt%rho_forest(s,o)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor @@ -2552,9 +2495,8 @@ function getRho(instance,of,ip,el) getRho(:,mob) = max(getRho(:,mob),0.0_pReal) getRho(:,dip) = max(getRho(:,dip),0.0_pReal) - where (abs(getRho) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & - .or. abs(getRho) < prm%significantRho) & - getRho = 0.0_pReal + where (abs(getRho) < max (prm%significantN/mesh_ipVolume(ip,el) ** (2.0_pReal/3.0_pReal), & + prm%significantRho)) getRho = 0.0_pReal end associate end function getRho From 1614bfb6d7de3c55ac405493685fcac8f60cc724 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 09:15:41 +0100 Subject: [PATCH 08/19] test now activates shortrange correction --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c79dc5f1b..3047f7af1 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c79dc5f1be75f90b0638c230d56c962bfd3b2474 +Subproject commit 3047f7af15c3e77f0b2d9c19e9f581cf904b43ad From fa513778c04508c9f6b393fe4d34693e2b5c5936 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 11:51:26 +0100 Subject: [PATCH 09/19] array access was wrong now using the rectified dislocation density from "getRho". This results in a slightly more conservative sensitivity check --- src/plastic_nonlocal.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 296276d9f..2395e92cb 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -2028,8 +2028,8 @@ results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation #endif -if ( any(stt%rho(:,mob) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & - .or. any(stt%rho(:,dip) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then +if ( any(rho(:,mob) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & + .or. any(rho(:,dip) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip @@ -2495,8 +2495,8 @@ function getRho(instance,of,ip,el) getRho(:,mob) = max(getRho(:,mob),0.0_pReal) getRho(:,dip) = max(getRho(:,dip),0.0_pReal) - where (abs(getRho) < max (prm%significantN/mesh_ipVolume(ip,el) ** (2.0_pReal/3.0_pReal), & - prm%significantRho)) getRho = 0.0_pReal + where(abs(getRho) < max(prm%significantN/mesh_ipVolume(ip,el) ** (2.0_pReal/3.0_pReal),prm%significantRho)) & + getRho = 0.0_pReal end associate end function getRho From 52b54ddf237e489a746d9f8dc2fecfd70b9da629 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 12:36:15 +0100 Subject: [PATCH 10/19] direct access to state variable --- src/plastic_nonlocal.f90 | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 2395e92cb..7f8cc2624 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -15,10 +15,10 @@ module plastic_nonlocal KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_nonlocal_sizePostResult !< size of each post result output + plastic_nonlocal_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_nonlocal_output !< name of each post result output + plastic_nonlocal_output !< name of each post result output integer, dimension(8), parameter :: & sgl = [1,2,3,4,5,6,7,8] @@ -42,8 +42,6 @@ module plastic_nonlocal imm_edg = imm(1:2), & imm_scr = imm(3:4) - integer(pInt), dimension(:,:), allocatable, private :: & - iRhoF !< state indices for forest density integer(pInt), dimension(:,:,:), allocatable, private :: & iRhoU, & !< state indices for unblocked density iRhoB, & !< state indices for blocked density @@ -716,7 +714,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' allocate(iRhoD(maxval(totalNslip),2,maxNinstances), source=0_pInt) allocate(iV(maxval(totalNslip),4,maxNinstances), source=0_pInt) allocate(iD(maxval(totalNslip),2,maxNinstances), source=0_pInt) - allocate(iRhoF(maxval(totalNslip),maxNinstances), source=0_pInt) ! END DEPRECATED------------------------------------------------------------------------------------ allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & @@ -749,11 +746,8 @@ allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPn enddo l = l + param(phase_plasticityInstance(p))%totalNslip ! shear(rates) - - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iRhoF(s,phase_plasticityInstance(p)) = l - enddo + l = l + param(phase_plasticityInstance(p))%totalNslip ! rho_forest + do t = 1_pInt,4_pInt do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt @@ -2253,7 +2247,6 @@ function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) gdot, & !< shear rates v !< velocities real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & - rhoForest, & !< forest dislocation density tau !< current resolved shear stress real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) @@ -2282,7 +2275,6 @@ forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) rhoDip(s,c) = plasticState(ph)%State(iRhoD(s,c,instance),of) rhoDotDip(s,c) = plasticState(ph)%dotState(iRhoD(s,c,instance),of) endforall -rhoForest = plasticState(ph)%State(iRhoF(1:ns,instance),of) !* Calculate shear rate @@ -2356,7 +2348,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) cs = cs + ns case (rho_forest_ID) - postResults(cs+1_pInt:cs+ns) = rhoForest + postResults(cs+1_pInt:cs+ns) = stt%rho_forest(:,of) cs = cs + ns case (shearrate_ID) @@ -2495,7 +2487,7 @@ function getRho(instance,of,ip,el) getRho(:,mob) = max(getRho(:,mob),0.0_pReal) getRho(:,dip) = max(getRho(:,dip),0.0_pReal) - where(abs(getRho) < max(prm%significantN/mesh_ipVolume(ip,el) ** (2.0_pReal/3.0_pReal),prm%significantRho)) & + where(abs(getRho) < max(prm%significantN/mesh_ipVolume(ip,el)**(2.0_pReal/3.0_pReal),prm%significantRho)) & getRho = 0.0_pReal end associate From d7739fa8f876c9fe0811076fb7119a16843b3af5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 13:29:58 +0100 Subject: [PATCH 11/19] no derived quantities in postResults preparing for HDF5 out --- src/plastic_nonlocal.f90 | 74 ++-------------------------------------- 1 file changed, 3 insertions(+), 71 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 7f8cc2624..726c3cd23 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -69,14 +69,11 @@ module plastic_nonlocal rho_dip_scr_ID, & rho_forest_ID, & shearrate_ID, & - resolvedstress_ID, & - resolvedstress_external_ID, & resolvedstress_back_ID, & resistance_ID, & rho_dot_sgl_ID, & rho_dot_sgl_mobile_ID, & rho_dot_dip_ID, & - rho_dot_gen_ID, & rho_dot_gen_edge_ID, & rho_dot_gen_screw_ID, & rho_dot_sgl2dip_edge_ID, & @@ -92,8 +89,6 @@ module plastic_nonlocal velocity_edge_neg_ID, & velocity_screw_pos_ID, & velocity_screw_neg_ID, & - maximumdipoleheight_edge_ID, & - maximumdipoleheight_screw_ID, & accumulatedshear_ID end enum @@ -530,10 +525,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' outputID = merge(rho_forest_ID,undefined_ID,prm%totalNslip>0_pInt) case ('shearrate') outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('resolvedstress') - outputID = merge(resolvedstress_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('resolvedstress_external') - outputID = merge(resolvedstress_external_ID,undefined_ID,prm%totalNslip>0_pInt) case ('resolvedstress_back') outputID = merge(resolvedstress_back_ID,undefined_ID,prm%totalNslip>0_pInt) case ('resistance') @@ -544,8 +535,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' outputID = merge(rho_dot_sgl_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_dot_dip') outputID = merge(rho_dot_dip_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('rho_dot_gen') - outputID = merge(rho_dot_gen_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_dot_gen_edge') outputID = merge(rho_dot_gen_edge_ID,undefined_ID,prm%totalNslip>0_pInt) case ('rho_dot_gen_screw') @@ -576,10 +565,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' outputID = merge(velocity_screw_pos_ID,undefined_ID,prm%totalNslip>0_pInt) case ('velocity_screw_neg') outputID = merge(velocity_screw_neg_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('maximumdipoleheight_edge') - outputID = merge(maximumdipoleheight_edge_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('maximumdipoleheight_screw') - outputID = merge(maximumdipoleheight_screw_ID,undefined_ID,prm%totalNslip>0_pInt) case ('accumulatedshear','accumulated_shear') outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0_pInt) end select @@ -2210,10 +2195,6 @@ end subroutine plastic_nonlocal_updateCompatibility function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) use prec, only: & dNeq0 - use math, only: & - math_mul33x3, & - math_mul33xx33, & - pi use material, only: & material_phase, & phaseAt, phasememberAt, & @@ -2241,18 +2222,14 @@ function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) s !< index of my current slip system real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & - rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) + rhoSgl, & rhoDotSgl !< evolution rate of single dislocation densities (positive/negative screw and edge without dipoles) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & gdot, & !< shear rates v !< velocities - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & - tau !< current resolved shear stress real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & - rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) - rhoDotDip, & !< evolution rate of dipole dislocation densities (screw and edge dipoles) - dLower, & !< minimum stable dipole distance for edges and screws - dUpper !< current maximum stable dipole distance for edges and screws + rhoDotDip !< evolution rate of dipole dislocation densities (screw and edge dipoles) + ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) @@ -2265,14 +2242,11 @@ associate(prm => param(instance),dst => microstructure(instance),stt=>state(inst !* short hand notations for state variables forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = plasticState(ph)%State(iRhoU(s,t,instance),of) rhoSgl(s,t+4_pInt) = plasticState(ph)%State(iRhoB(s,t,instance),of) v(s,t) = plasticState(ph)%State(iV(s,t,instance),of) - rhoDotSgl(s,t) = plasticState(ph)%dotState(iRhoU(s,t,instance),of) rhoDotSgl(s,t+4_pInt) = plasticState(ph)%dotState(iRhoB(s,t,instance),of) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = plasticState(ph)%State(iRhoD(s,c,instance),of) rhoDotDip(s,c) = plasticState(ph)%dotState(iRhoD(s,c,instance),of) endforall @@ -2284,25 +2258,6 @@ forall (t = 1_pInt:4_pInt) & !* calculate limits for stable dipole height -do s = 1_pInt,ns - tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,of) - if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal -enddo - -dLower = prm%minDipoleHeight(1:ns,1:2) -dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & - / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) -dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & - / (4.0_pReal * pi * abs(tau)) -do c = 1, 2 - where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& - +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & - dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & - + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & - dUpper(1:ns,c)) -enddo -dUpper = max(dUpper,dLower) - outputsLoop: do o = 1_pInt,size(param(instance)%outputID) select case(param(instance)%outputID(o)) @@ -2355,20 +2310,10 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) postResults(cs+1_pInt:cs+ns) = sum(gdot,2) cs = cs + ns - case (resolvedstress_ID) - postResults(cs+1_pInt:cs+ns) = tau - cs = cs + ns - case (resolvedstress_back_ID) postResults(cs+1_pInt:cs+ns) = dst%tau_back(:,of) cs = cs + ns - case (resolvedstress_external_ID) - do s = 1_pInt,ns - postResults(cs+s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) - enddo - cs = cs + ns - case (resistance_ID) postResults(cs+1_pInt:cs+ns) = dst%tau_Threshold(:,of) cs = cs + ns @@ -2385,11 +2330,6 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) case (rho_dot_dip_ID) postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) cs = cs + ns - - case (rho_dot_gen_ID) ! Obsolete - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,1,of) & - + results(instance)%rhoDotMultiplication(1:ns,2,of) - cs = cs + ns case (rho_dot_gen_edge_ID) postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,1,of) @@ -2453,14 +2393,6 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) case (velocity_screw_neg_ID) postResults(cs+1_pInt:cs+ns) = v(1:ns,4) cs = cs + ns - - case (maximumdipoleheight_edge_ID) - postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1) - cs = cs + ns - - case (maximumdipoleheight_screw_ID) - postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2) - cs = cs + ns case(accumulatedshear_ID) postResults(cs+1_pInt:cs+ns) = stt%accumulatedshear(:,of) From 5f41d6d9b49496ab95c40d45f411baaaa35113a0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 13:35:41 +0100 Subject: [PATCH 12/19] no pInt --- src/plastic_nonlocal.f90 | 629 +++++++++++++++++++-------------------- 1 file changed, 314 insertions(+), 315 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 726c3cd23..88f8d0ec9 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -6,15 +6,14 @@ !-------------------------------------------------------------------------------------------------- module plastic_nonlocal use prec, only: & - pReal, & - pInt + pReal implicit none private real(pReal), parameter, private :: & KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & plastic_nonlocal_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & @@ -42,14 +41,14 @@ module plastic_nonlocal imm_edg = imm(1:2), & imm_scr = imm(3:4) - integer(pInt), dimension(:,:,:), allocatable, private :: & + integer, dimension(:,:,:), allocatable, private :: & iRhoU, & !< state indices for unblocked density iRhoB, & !< state indices for blocked density iRhoD, & !< state indices for dipole density iV, & !< state indices for dislcation velocities iD !< state indices for stable dipole height - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, private, protected :: & totalNslip !< total number of active slip systems for each instance real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & @@ -146,14 +145,14 @@ module plastic_nonlocal forestProjection_Screw !< matrix of forest projections of screw dislocations real(pReal), dimension(:), allocatable, private :: & nonSchmidCoeff - integer(pInt) :: totalNslip + integer :: totalNslip real(pReal), dimension(:,:,:), allocatable, private :: & Schmid, & !< Schmid contribution nonSchmid_pos, & nonSchmid_neg !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) - integer(pInt) , dimension(:) ,allocatable , public:: & + integer , dimension(:) ,allocatable , public:: & Nslip,& colinearSystem !< colinear system to the active slip system (only valid for fcc!) @@ -274,10 +273,10 @@ subroutine plastic_nonlocal_init implicit none character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + integer, dimension(0), parameter :: emptyIntArray = [integer::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] - integer(pInt) :: & + integer :: & maxNinstances, & p, i, & l, & @@ -286,14 +285,14 @@ subroutine plastic_nonlocal_init t, & ! index of dislocation type c ! index of dislocation character - integer(pInt) :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState + integer :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState integer(kind(undefined_ID)) :: & outputID character(len=512) :: & extmsg = '', & structure character(len=65536), dimension(:), allocatable :: outputs - integer(pInt) :: NofMyPhase + integer :: NofMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>' @@ -315,14 +314,14 @@ subroutine plastic_nonlocal_init allocate(microstructure(maxNinstances)) allocate(results(maxNinstances)) - allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) + allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0) allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) plastic_nonlocal_output = '' allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) - allocate(totalNslip(maxNinstances), source=0_pInt) + allocate(totalNslip(maxNinstances), source=0) - do p=1_pInt, size(config_phase) + do p=1, size(config_phase) if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & @@ -344,15 +343,15 @@ subroutine plastic_nonlocal_init prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) - slipActive: if (prm%totalNslip > 0_pInt) then + slipActive: if (prm%totalNslip > 0) then prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) if(trim(config%getString('lattice_structure')) == 'bcc') then prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& defaultVal = emptyRealArray) - prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) - prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1) else prm%nonSchmid_pos = prm%Schmid prm%nonSchmid_neg = prm%Schmid @@ -375,9 +374,9 @@ subroutine plastic_nonlocal_init config%getFloat('c/a',defaultVal=0.0_pReal)) ! collinear systems (only for octahedral slip systems in fcc) - allocate(prm%colinearSystem(prm%totalNslip), source = -1_pInt) - do s1 = 1_pInt, prm%totalNslip - do s2 = 1_pInt, prm%totalNslip + allocate(prm%colinearSystem(prm%totalNslip), source = -1) + do s1 = 1, prm%totalNslip + do s2 = 1, prm%totalNslip if (all(dEq0 (math_cross(prm%slip_direction(1:3,s1),prm%slip_direction(1:3,s2)))) .and. & any(dNeq0(math_cross(prm%slip_normal (1:3,s1),prm%slip_normal (1:3,s2))))) & prm%colinearSystem(s1) = s2 @@ -498,75 +497,75 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(trim(outputs(i))) case ('rho_sgl_edge_pos_mobile') - outputID = merge(rho_sgl_mob_edg_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_edg_pos_ID,undefined_ID,prm%totalNslip>0) case ('rho_sgl_edge_neg_mobile') - outputID = merge(rho_sgl_mob_edg_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_edg_neg_ID,undefined_ID,prm%totalNslip>0) case ('rho_sgl_screw_pos_mobile') - outputID = merge(rho_sgl_mob_scr_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_scr_pos_ID,undefined_ID,prm%totalNslip>0) case ('rho_sgl_screw_neg_mobile') - outputID = merge(rho_sgl_mob_scr_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_mob_scr_neg_ID,undefined_ID,prm%totalNslip>0) case ('rho_sgl_edge_pos_immobile') - outputID = merge(rho_sgl_imm_edg_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_edg_pos_ID,undefined_ID,prm%totalNslip>0) case ('rho_sgl_edge_neg_immobile') - outputID = merge(rho_sgl_imm_edg_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_edg_neg_ID,undefined_ID,prm%totalNslip>0) case ('rho_sgl_screw_pos_immobile') - outputID = merge(rho_sgl_imm_scr_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_scr_pos_ID,undefined_ID,prm%totalNslip>0) case ('rho_sgl_screw_neg_immobile') - outputID = merge(rho_sgl_imm_scr_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_sgl_imm_scr_neg_ID,undefined_ID,prm%totalNslip>0) case ('rho_dip_edge') - outputID = merge(rho_dip_edg_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dip_edg_ID,undefined_ID,prm%totalNslip>0) case ('rho_dip_screw') - outputID = merge(rho_dip_scr_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dip_scr_ID,undefined_ID,prm%totalNslip>0) case ('rho_forest') - outputID = merge(rho_forest_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_forest_ID,undefined_ID,prm%totalNslip>0) case ('shearrate') - outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0) case ('resolvedstress_back') - outputID = merge(resolvedstress_back_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(resolvedstress_back_ID,undefined_ID,prm%totalNslip>0) case ('resistance') - outputID = merge(resistance_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(resistance_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_sgl') - outputID = merge(rho_dot_sgl_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_sgl_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_sgl_mobile') - outputID = merge(rho_dot_sgl_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_sgl_mobile_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_dip') - outputID = merge(rho_dot_dip_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_dip_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_gen_edge') - outputID = merge(rho_dot_gen_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_gen_edge_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_gen_screw') - outputID = merge(rho_dot_gen_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_gen_screw_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_sgl2dip_edge') - outputID = merge(rho_dot_sgl2dip_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_sgl2dip_edge_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_sgl2dip_screw') - outputID = merge(rho_dot_sgl2dip_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_sgl2dip_screw_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_ann_ath') - outputID = merge(rho_dot_ann_ath_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_ann_ath_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_ann_the_edge') - outputID = merge(rho_dot_ann_the_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_ann_the_edge_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_ann_the_screw') - outputID = merge(rho_dot_ann_the_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_ann_the_screw_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_edgejogs') - outputID = merge(rho_dot_edgejogs_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_edgejogs_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_flux_mobile') - outputID = merge(rho_dot_flux_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_flux_mobile_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_flux_edge') - outputID = merge(rho_dot_flux_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_flux_edge_ID,undefined_ID,prm%totalNslip>0) case ('rho_dot_flux_screw') - outputID = merge(rho_dot_flux_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(rho_dot_flux_screw_ID,undefined_ID,prm%totalNslip>0) case ('velocity_edge_pos') - outputID = merge(velocity_edge_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(velocity_edge_pos_ID,undefined_ID,prm%totalNslip>0) case ('velocity_edge_neg') - outputID = merge(velocity_edge_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(velocity_edge_neg_ID,undefined_ID,prm%totalNslip>0) case ('velocity_screw_pos') - outputID = merge(velocity_screw_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(velocity_screw_pos_ID,undefined_ID,prm%totalNslip>0) case ('velocity_screw_neg') - outputID = merge(velocity_screw_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(velocity_screw_neg_ID,undefined_ID,prm%totalNslip>0) case ('accumulatedshear','accumulated_shear') - outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0_pInt) + outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0) end select if (outputID /= undefined_ID) then @@ -580,100 +579,100 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' !-------------------------------------------------------------------------------------------------- ! allocate state arrays NofMyPhase=count(material_phase==p) - sizeDotState = int(size([ 'rhoSglEdgePosMobile ','rhoSglEdgeNegMobile ', & - 'rhoSglScrewPosMobile ','rhoSglScrewNegMobile ', & - 'rhoSglEdgePosImmobile ','rhoSglEdgeNegImmobile ', & - 'rhoSglScrewPosImmobile','rhoSglScrewNegImmobile', & - 'rhoDipEdge ','rhoDipScrew ', & - 'accumulatedshear ' ]),pInt) * prm%totalNslip !< "basic" microstructural state variables that are independent from other state variables - sizeDependentState = int(size([ 'rhoForest ']),pInt) * prm%totalNslip !< microstructural state variables that depend on other state variables + sizeDotState = size([ 'rhoSglEdgePosMobile ','rhoSglEdgeNegMobile ', & + 'rhoSglScrewPosMobile ','rhoSglScrewNegMobile ', & + 'rhoSglEdgePosImmobile ','rhoSglEdgeNegImmobile ', & + 'rhoSglScrewPosImmobile','rhoSglScrewNegImmobile', & + 'rhoDipEdge ','rhoDipScrew ', & + 'accumulatedshear ' ]) * prm%totalNslip !< "basic" microstructural state variables that are independent from other state variables + sizeDependentState = size([ 'rhoForest '])) * prm%totalNslip !< microstructural state variables that depend on other state variables sizeState = sizeDotState + sizeDependentState & - + int(size([ 'velocityEdgePos ','velocityEdgeNeg ', & - 'velocityScrewPos ','velocityScrewNeg ', & - 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]),pInt) * prm%totalNslip !< other dependent state variables that are not updated by microstructure + + size([ 'velocityEdgePos ','velocityEdgeNeg ', & + 'velocityScrewPos ','velocityScrewNeg ', & + 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]) * prm%totalNslip !< other dependent state variables that are not updated by microstructure sizeDeltaState = sizeDotState call material_allocatePlasticState(p,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & - prm%totalNslip,0_pInt,0_pInt) + prm%totalNslip,0,0) plasticState(p)%nonlocal = .true. - plasticState(p)%offsetDeltaState = 0_pInt ! ToDo: state structure does not follow convention + plasticState(p)%offsetDeltaState = 0 ! ToDo: state structure does not follow convention plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(p))) totalNslip(phase_plasticityInstance(p)) = prm%totalNslip ! ToDo: Not really sure if this large number of mostly overlapping pointers is useful - stt%rho => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - dot%rho => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - del%rho => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - plasticState(p)%aTolState(1:10_pInt*prm%totalNslip) = prm%aTolRho + stt%rho => plasticState(p)%state (0*prm%totalNslip+1:10*prm%totalNslip,:) + dot%rho => plasticState(p)%dotState (0*prm%totalNslip+1:10*prm%totalNslip,:) + del%rho => plasticState(p)%deltaState (0*prm%totalNslip+1:10*prm%totalNslip,:) + plasticState(p)%aTolState(1:10*prm%totalNslip) = prm%aTolRho - stt%rhoSglEdge => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:06_pInt*prm%totalNslip:2*prm%totalNslip,:) - stt%rhoSglScrew => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt:08_pInt*prm%totalNslip:2*prm%totalNslip,:) + stt%rhoSglEdge => plasticState(p)%state (0*prm%totalNslip+1:06*prm%totalNslip:2*prm%totalNslip,:) + stt%rhoSglScrew => plasticState(p)%state (2*prm%totalNslip+1:08*prm%totalNslip:2*prm%totalNslip,:) - stt%rhoSgl => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - dot%rhoSgl => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - del%rhoSgl => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + stt%rhoSgl => plasticState(p)%state (0*prm%totalNslip+1: 8*prm%totalNslip,:) + dot%rhoSgl => plasticState(p)%dotState (0*prm%totalNslip+1: 8*prm%totalNslip,:) + del%rhoSgl => plasticState(p)%deltaState (0*prm%totalNslip+1: 8*prm%totalNslip,:) - stt%rhoSglMobile => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - dot%rhoSglMobile => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - del%rhoSglMobile => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + stt%rhoSglMobile => plasticState(p)%state (0*prm%totalNslip+1: 4*prm%totalNslip,:) + dot%rhoSglMobile => plasticState(p)%dotState (0*prm%totalNslip+1: 4*prm%totalNslip,:) + del%rhoSglMobile => plasticState(p)%deltaState (0*prm%totalNslip+1: 4*prm%totalNslip,:) - stt%rho_sgl_mob_edg_pos => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) - dot%rho_sgl_mob_edg_pos => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) - del%rho_sgl_mob_edg_pos => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_edg_pos => plasticState(p)%state (0*prm%totalNslip+1: 1*prm%totalNslip,:) + dot%rho_sgl_mob_edg_pos => plasticState(p)%dotState (0*prm%totalNslip+1: 1*prm%totalNslip,:) + del%rho_sgl_mob_edg_pos => plasticState(p)%deltaState (0*prm%totalNslip+1: 1*prm%totalNslip,:) - stt%rho_sgl_mob_edg_neg => plasticState(p)%state (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - dot%rho_sgl_mob_edg_neg => plasticState(p)%dotState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) - del%rho_sgl_mob_edg_neg => plasticState(p)%deltaState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_edg_neg => plasticState(p)%state (1*prm%totalNslip+1: 2*prm%totalNslip,:) + dot%rho_sgl_mob_edg_neg => plasticState(p)%dotState (1*prm%totalNslip+1: 2*prm%totalNslip,:) + del%rho_sgl_mob_edg_neg => plasticState(p)%deltaState (1*prm%totalNslip+1: 2*prm%totalNslip,:) - stt%rho_sgl_mob_scr_pos => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) - dot%rho_sgl_mob_scr_pos => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) - del%rho_sgl_mob_scr_pos => plasticState(p)%deltaState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_scr_pos => plasticState(p)%state (2*prm%totalNslip+1: 3*prm%totalNslip,:) + dot%rho_sgl_mob_scr_pos => plasticState(p)%dotState (2*prm%totalNslip+1: 3*prm%totalNslip,:) + del%rho_sgl_mob_scr_pos => plasticState(p)%deltaState (2*prm%totalNslip+1: 3*prm%totalNslip,:) - stt%rho_sgl_mob_scr_neg => plasticState(p)%state (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - dot%rho_sgl_mob_scr_neg => plasticState(p)%dotState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - del%rho_sgl_mob_scr_neg => plasticState(p)%deltaState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + stt%rho_sgl_mob_scr_neg => plasticState(p)%state (3*prm%totalNslip+1: 4*prm%totalNslip,:) + dot%rho_sgl_mob_scr_neg => plasticState(p)%dotState (3*prm%totalNslip+1: 4*prm%totalNslip,:) + del%rho_sgl_mob_scr_neg => plasticState(p)%deltaState (3*prm%totalNslip+1: 4*prm%totalNslip,:) - stt%rhoSglImmobile => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - dot%rhoSglImmobile => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - del%rhoSglImmobile => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + stt%rhoSglImmobile => plasticState(p)%state (4*prm%totalNslip+1: 8*prm%totalNslip,:) + dot%rhoSglImmobile => plasticState(p)%dotState (4*prm%totalNslip+1: 8*prm%totalNslip,:) + del%rhoSglImmobile => plasticState(p)%deltaState (4*prm%totalNslip+1: 8*prm%totalNslip,:) - stt%rho_sgl_imm_edg_pos => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) - dot%rho_sgl_imm_edg_pos => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) - del%rho_sgl_imm_edg_pos => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_edg_pos => plasticState(p)%state (4*prm%totalNslip+1: 5*prm%totalNslip,:) + dot%rho_sgl_imm_edg_pos => plasticState(p)%dotState (4*prm%totalNslip+1: 5*prm%totalNslip,:) + del%rho_sgl_imm_edg_pos => plasticState(p)%deltaState (4*prm%totalNslip+1: 5*prm%totalNslip,:) - stt%rho_sgl_imm_edg_neg => plasticState(p)%state (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - dot%rho_sgl_imm_edg_neg => plasticState(p)%dotState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) - del%rho_sgl_imm_edg_neg => plasticState(p)%deltaState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_edg_neg => plasticState(p)%state (5*prm%totalNslip+1: 6*prm%totalNslip,:) + dot%rho_sgl_imm_edg_neg => plasticState(p)%dotState (5*prm%totalNslip+1: 6*prm%totalNslip,:) + del%rho_sgl_imm_edg_neg => plasticState(p)%deltaState (5*prm%totalNslip+1: 6*prm%totalNslip,:) - stt%rho_sgl_imm_scr_pos => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) - dot%rho_sgl_imm_scr_pos => plasticState(p)%dotState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) - del%rho_sgl_imm_scr_pos => plasticState(p)%deltaState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_scr_pos => plasticState(p)%state (6*prm%totalNslip+1: 7*prm%totalNslip,:) + dot%rho_sgl_imm_scr_pos => plasticState(p)%dotState(6*prm%totalNslip+1: 7*prm%totalNslip,:) + del%rho_sgl_imm_scr_pos => plasticState(p)%deltaState(6*prm%totalNslip+1: 7*prm%totalNslip,:) - stt%rho_sgl_imm_scr_neg => plasticState(p)%state (7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - dot%rho_sgl_imm_scr_neg => plasticState(p)%dotState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) - del%rho_sgl_imm_scr_neg => plasticState(p)%deltaState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + stt%rho_sgl_imm_scr_neg => plasticState(p)%state (7*prm%totalNslip+1: 8*prm%totalNslip,:) + dot%rho_sgl_imm_scr_neg => plasticState(p)%dotState(7*prm%totalNslip+1: 8*prm%totalNslip,:) + del%rho_sgl_imm_scr_neg => plasticState(p)%deltaState(7*prm%totalNslip+1: 8*prm%totalNslip,:) - stt%rhoDip => plasticState(p)%state (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - dot%rhoDip => plasticState(p)%dotState (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - del%rhoDip => plasticState(p)%deltaState (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + stt%rhoDip => plasticState(p)%state (8*prm%totalNslip+1:10*prm%totalNslip,:) + dot%rhoDip => plasticState(p)%dotState (8*prm%totalNslip+1:10*prm%totalNslip,:) + del%rhoDip => plasticState(p)%deltaState (8*prm%totalNslip+1:10*prm%totalNslip,:) - stt%rho_dip_edg => plasticState(p)%state (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) - dot%rho_dip_edg => plasticState(p)%dotState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) - del%rho_dip_edg => plasticState(p)%deltaState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) + stt%rho_dip_edg => plasticState(p)%state (8*prm%totalNslip+1: 9*prm%totalNslip,:) + dot%rho_dip_edg => plasticState(p)%dotState (8*prm%totalNslip+1: 9*prm%totalNslip,:) + del%rho_dip_edg => plasticState(p)%deltaState (8*prm%totalNslip+1: 9*prm%totalNslip,:) - stt%rho_dip_scr => plasticState(p)%state (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - dot%rho_dip_scr => plasticState(p)%dotState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - del%rho_dip_scr => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + stt%rho_dip_scr => plasticState(p)%state (9*prm%totalNslip+1:10*prm%totalNslip,:) + dot%rho_dip_scr => plasticState(p)%dotState (9*prm%totalNslip+1:10*prm%totalNslip,:) + del%rho_dip_scr => plasticState(p)%deltaState (9*prm%totalNslip+1:10*prm%totalNslip,:) - stt%accumulatedshear => plasticState(p)%state (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) - dot%accumulatedshear => plasticState(p)%dotState (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) - del%accumulatedshear => plasticState(p)%deltaState (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) - plasticState(p)%aTolState(10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ) = prm%aTolShear - plasticState(p)%slipRate => plasticState(p)%dotState(10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) - plasticState(p)%accumulatedSlip => plasticState(p)%state (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) + stt%accumulatedshear => plasticState(p)%state (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) + dot%accumulatedshear => plasticState(p)%dotState (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) + del%accumulatedshear => plasticState(p)%deltaState (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) + plasticState(p)%aTolState(10*prm%totalNslip + 1:11*prm%totalNslip ) = prm%aTolShear + plasticState(p)%slipRate => plasticState(p)%dotState(10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) + plasticState(p)%accumulatedSlip => plasticState(p)%state (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) - stt%rho_forest => plasticState(p)%state (11_pInt*prm%totalNslip + 1_pInt:12_pInt*prm%totalNslip ,1:NofMyPhase) + stt%rho_forest => plasticState(p)%state (11*prm%totalNslip + 1:12*prm%totalNslip ,1:NofMyPhase) allocate(dst%tau_Threshold(prm%totalNslip,NofMyPhase),source=0.0_pReal) @@ -688,44 +687,44 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' end associate - if (NofMyPhase > 0_pInt) call stateInit(p,NofMyPhase) + if (NofMyPhase > 0) call stateInit(p,NofMyPhase) plasticState(p)%state0 = plasticState(p)%state enddo ! BEGIN DEPRECATED---------------------------------------------------------------------------------- - allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0_pInt) - allocate(iRhoB(maxval(totalNslip),4,maxNinstances), source=0_pInt) - allocate(iRhoD(maxval(totalNslip),2,maxNinstances), source=0_pInt) - allocate(iV(maxval(totalNslip),4,maxNinstances), source=0_pInt) - allocate(iD(maxval(totalNslip),2,maxNinstances), source=0_pInt) + allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0) + allocate(iRhoB(maxval(totalNslip),4,maxNinstances), source=0) + allocate(iRhoD(maxval(totalNslip),2,maxNinstances), source=0) + allocate(iV(maxval(totalNslip),4,maxNinstances), source=0) + allocate(iD(maxval(totalNslip),2,maxNinstances), source=0) ! END DEPRECATED------------------------------------------------------------------------------------ allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) - initializeInstances: do p = 1_pInt, size(phase_plasticity) + initializeInstances: do p = 1, size(phase_plasticity) NofMyPhase=count(material_phase==p) myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then !*** determine indices to state array - l = 0_pInt - do t = 1_pInt,4_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt + l = 0 + do t = 1,4 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 iRhoU(s,t,phase_plasticityInstance(p)) = l enddo enddo - do t = 1_pInt,4_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt + do t = 1,4 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 iRhoB(s,t,phase_plasticityInstance(p)) = l enddo enddo - do c = 1_pInt,2_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt + do c = 1,2 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 iRhoD(s,c,phase_plasticityInstance(p)) = l enddo enddo @@ -733,20 +732,20 @@ allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPn l = l + param(phase_plasticityInstance(p))%totalNslip ! shear(rates) l = l + param(phase_plasticityInstance(p))%totalNslip ! rho_forest - do t = 1_pInt,4_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt + do t = 1,4 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 iV(s,t,phase_plasticityInstance(p)) = l enddo enddo - do c = 1_pInt,2_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt + do c = 1,2 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 iD(s,c,phase_plasticityInstance(p)) = l enddo enddo if (iD(param(phase_plasticityInstance(p))%totalNslip,2,phase_plasticityInstance(p)) /= plasticState(p)%sizeState) & ! check if last index is equal to size of state - call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') + call IO_error(0, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') endif myPhase2 @@ -812,8 +811,8 @@ subroutine stateInit(phase,NofMyPhase) meanDensity = 0.0_pReal do while(meanDensity < prm%rhoSglRandom) call random_number(rnd) - phasemember = nint(rnd(1)*real(NofMyPhase,pReal) + 0.5_pReal,pInt) - s = nint(rnd(2)*real(prm%totalNslip,pReal)*4.0_pReal + 0.5_pReal,pInt) + phasemember = nint(rnd(1)*real(NofMyPhase,pReal) + 0.5_pReal) + s = nint(rnd(2)*real(prm%totalNslip,pReal)*4.0_pReal + 0.5_pReal) meanDensity = meanDensity + densityBinning * volume(phasemember) / totalVolume stt%rhoSglMobile(s,phasemember) = densityBinning enddo @@ -886,18 +885,18 @@ use lattice, only: & implicit none -integer(pInt), intent(in) :: ip, & ! current integration point +integer, intent(in) :: ip, & ! current integration point el ! current element real(pReal), dimension(3,3), intent(in) :: & Fe, & ! elastic deformation gradient Fp ! elastic deformation gradient - integer(pInt) :: & + integer :: & ph, & !< phase of, & !< offset no !< nieghbor offset -integer(pInt) ns, neighbor_el, & ! element number of neighboring material point +integer ns, neighbor_el, & ! element number of neighboring material point neighbor_ip, & ! integration point of neighboring material point instance, & ! my instance of this plasticity neighbor_instance, & ! instance of this plasticity of neighboring material point @@ -906,7 +905,7 @@ integer(pInt) ns, neighbor_el, & ! element numb dir, & n, & nRealNeighbors ! number of really existing neighbors -integer(pInt), dimension(2) :: neighbors +integer, dimension(2) :: neighbors real(pReal) FVsize, & correction real(pReal), dimension(2) :: rhoExcessGradient, & @@ -920,7 +919,7 @@ real(pReal), dimension(3,3) :: invFe, & ! inverse of elast invConnections real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & connection_latticeConf -real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & +real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & rhoExcess real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & rho_edg_delta, & @@ -928,8 +927,8 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & rho, & rho_neighbor -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & - totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))), & + totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),theMesh%elem%nIPneighbors) :: & @@ -940,7 +939,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point -real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & +real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & m ! direction of dislocation motion ph = phaseAt(1,ip,el) @@ -961,7 +960,7 @@ stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) !*** (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals) if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc - do s = 1_pInt,ns + do s = 1,ns correction = ( 1.0_pReal - prm%linetensionEffect & + prm%linetensionEffect & * log(0.35_pReal * prm%burgers(s) * sqrt(max(stt%rho_forest(s,of),prm%significantRho))) & @@ -971,7 +970,7 @@ if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTI else myInteractionMatrix = prm%interactionSlipSlip endif -forall (s = 1_pInt:ns) & +forall (s = 1:ns) & dst%tau_threshold(s,of) = prm%mu * prm%burgers(s) & * sqrt(dot_product(sum(abs(rho),2), myInteractionMatrix(1:ns,s))) @@ -1004,7 +1003,7 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then nRealNeighbors = 0 neighbor_rhoTotal = 0.0_pReal - do n = 1_pInt,theMesh%elem%nIPneighbors + do n = 1,theMesh%elem%nIPneighbors neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) no = phasememberAt(1,neighbor_ip,neighbor_el) @@ -1052,20 +1051,20 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then m(1:3,1:ns,1) = prm%slip_direction m(1:3,1:ns,2) = -prm%slip_transverse - do s = 1_pInt,ns + do s = 1,ns ! gradient from interpolation of neighboring excess density ... - do c = 1_pInt,2_pInt - do dir = 1_pInt,3_pInt - neighbors(1) = 2_pInt * dir - 1_pInt - neighbors(2) = 2_pInt * dir + do c = 1,2 + do dir = 1,3 + neighbors(1) = 2 * dir - 1 + neighbors(2) = 2 * dir connections(dir,1:3) = connection_latticeConf(1:3,neighbors(1)) & - connection_latticeConf(1:3,neighbors(2)) rhoExcessDifferences(dir) = neighbor_rhoExcess(c,s,neighbors(1)) & - neighbor_rhoExcess(c,s,neighbors(2)) enddo invConnections = math_inv33(connections) - if (all(dEq0(invConnections))) call IO_error(-1_pInt,ext_msg='back stress calculation: inversion error') + if (all(dEq0(invConnections))) call IO_error(-1,ext_msg='back stress calculation: inversion error') rhoExcessGradient(c) = math_mul3x3(m(1:3,s,c), math_mul33x3(invConnections,rhoExcessDifferences)) enddo @@ -1090,9 +1089,9 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then endif #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', stt%rho_forest(:,of) write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_threshold(:,of)*1e-6 @@ -1112,7 +1111,7 @@ subroutine plastic_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & tauThreshold, c, Temperature, instance, of) implicit none -integer(pInt), intent(in) :: c, & !< dislocation character (1:edge, 2:screw) +integer, intent(in) :: c, & !< dislocation character (1:edge, 2:screw) instance, of real(pReal), intent(in) :: Temperature !< temperature real(pReal), dimension(param(instance)%totalNslip), & @@ -1125,7 +1124,7 @@ real(pReal), dimension(param(instance)%totalNslip), & dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) -integer(pInt) :: ns, & !< short notation for the total number of active slip systems +integer :: ns, & !< short notation for the total number of active slip systems s !< index of my current slip system real(pReal) tauRel_P, & tauRel_S, & @@ -1157,7 +1156,7 @@ dv_dtauNS = 0.0_pReal if (Temperature > 0.0_pReal) then - do s = 1_pInt,ns + do s = 1,ns if (abs(tau(s)) > tauThreshold(s)) then !* Peierls contribution @@ -1257,7 +1256,7 @@ subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & phase_plasticityInstance implicit none -integer(pInt), intent(in) :: ip, & !< current integration point +integer, intent(in) :: ip, & !< current integration point el !< current element number real(pReal), intent(in) :: Temperature, & !< temperature volume !< volume of the materialpoint @@ -1268,7 +1267,7 @@ real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp !< derivative of Lp with respect to Tstar (9x9 matrix) -integer(pInt) instance, & !< current instance of this plasticity +integer instance, & !< current instance of this plasticity ns, & !< short notation for the total number of active slip systems i, & j, & @@ -1278,22 +1277,22 @@ integer(pInt) instance, & of, & !offset t, & !< dislocation type s !< index of my current slip system -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & rhoSgl !< single dislocation densities (including blocked) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),10) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & rho -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & v, & !< velocity tauNS, & !< resolved shear stress including non Schmid and backstress terms dv_dtau, & !< velocity derivative with respect to the shear stress dv_dtauNS !< velocity derivative with respect to the shear stress -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & tau, & !< resolved shear stress including backstress terms gdotTotal !< shear rate !*** shortcut for mapping -ph = phaseAt(1_pInt,ip,el) -of = phasememberAt(1_pInt,ip,el) +ph = phaseAt(1,ip,el) +of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst=>microstructure(instance)) @@ -1306,7 +1305,7 @@ rhoSgl = rho(:,sgl) !*** get resolved shear stress !*** for screws possible non-schmid contributions are also taken into account -do s = 1_pInt,ns +do s = 1,ns tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) tauNS(s,1) = tau(s) tauNS(s,2) = tau(s) @@ -1318,7 +1317,7 @@ do s = 1_pInt,ns tauNS(s,4) = math_mul33xx33(Mp, -prm%nonSchmid_pos(1:3,1:3,s)) endif enddo -forall (t = 1_pInt:4_pInt) & +forall (t = 1:4) & tauNS(1:ns,t) = tauNS(1:ns,t) + dst%tau_back(:,of) tau = tau + dst%tau_back(:,of) @@ -1328,35 +1327,35 @@ tau = tau + dst%tau_back(:,of) ! edges call plastic_nonlocal_kinetics(v(1:ns,1), dv_dtau(1:ns,1), dv_dtauNS(1:ns,1), & tau(1:ns), tauNS(1:ns,1), dst%tau_Threshold(1:ns,of), & - 1_pInt, Temperature, instance, of) + 1, Temperature, instance, of) v(1:ns,2) = v(1:ns,1) dv_dtau(1:ns,2) = dv_dtau(1:ns,1) dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) !screws -if (size(prm%nonSchmidCoeff) == 0_pInt) then ! no non-Schmid contributions - forall(t = 3_pInt:4_pInt) +if (size(prm%nonSchmidCoeff) == 0) then ! no non-Schmid contributions + forall(t = 3:4) v(1:ns,t) = v(1:ns,1) dv_dtau(1:ns,t) = dv_dtau(1:ns,1) dv_dtauNS(1:ns,t) = dv_dtauNS(1:ns,1) endforall else ! take non-Schmid contributions into account - do t = 3_pInt,4_pInt + do t = 3,4 call plastic_nonlocal_kinetics(v(1:ns,t), dv_dtau(1:ns,t), dv_dtauNS(1:ns,t), & tau(1:ns), tauNS(1:ns,t), dst%tau_Threshold(1:ns,of), & - 2_pInt , Temperature, instance, of) + 2 , Temperature, instance, of) enddo endif !*** store velocity in state -forall (t = 1_pInt:4_pInt) & +forall (t = 1:4) & plasticState(ph)%state(iV(1:ns,t,instance),of) = v(1:ns,t) !*** Bauschinger effect -forall (s = 1_pInt:ns, t = 5_pInt:8_pInt, rhoSgl(s,t) * v(s,t-4_pInt) < 0.0_pReal) & - rhoSgl(s,t-4_pInt) = rhoSgl(s,t-4_pInt) + abs(rhoSgl(s,t)) +forall (s = 1:ns, t = 5:8, rhoSgl(s,t) * v(s,t-4) < 0.0_pReal) & + rhoSgl(s,t-4) = rhoSgl(s,t-4) + abs(rhoSgl(s,t)) !*** Calculation of Lp and its tangent @@ -1366,9 +1365,9 @@ gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * prm%burgers(1:ns) Lp = 0.0_pReal dLp_dMp = 0.0_pReal -do s = 1_pInt,ns +do s = 1,ns Lp = Lp + gdotTotal(s) * prm%Schmid(1:3,1:3,s) - forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & + forall (i=1:3,j=1:3,k=1:3,l=1:3) & dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & + prm%Schmid(i,j,s) * prm%Schmid(k,l,s) & * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * prm%burgers(s) & @@ -1407,16 +1406,16 @@ use material, only: material_phase, & phase_plasticityInstance implicit none -integer(pInt), intent(in) :: ip, & ! current grain number +integer, intent(in) :: ip, & ! current grain number el ! current element number real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress - integer(pInt) :: & + integer :: & ph, & !< phase of !< offset -integer(pInt) ::instance, & ! current instance of this plasticity +integer ::instance, & ! current instance of this plasticity ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation t, & ! type of dislocation @@ -1445,10 +1444,10 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e ns = totalNslip(instance) !*** shortcut to state variables - forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) +forall (s = 1:ns, c = 1:2) dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) endforall @@ -1473,7 +1472,7 @@ deltaRhoRemobilization(:,dip) = 0.0_pReal !*** calculate limits for stable dipole height -do s = 1_pInt,prm%totalNslip +do s = 1,prm%totalNslip tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,of) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -1495,27 +1494,27 @@ deltaDUpper = dUpper - dUpperOld !*** dissociation by stress increase deltaRhoDipole2SingleStress = 0.0_pReal -forall (c=1_pInt:2_pInt, s=1_pInt:ns, deltaDUpper(s,c) < 0.0_pReal .and. & +forall (c=1:2, s=1:ns, deltaDUpper(s,c) < 0.0_pReal .and. & dNeq0(dUpperOld(s,c) - dLower(s,c))) & - deltaRhoDipole2SingleStress(s,8_pInt+c) = rhoDip(s,c) * deltaDUpper(s,c) & + deltaRhoDipole2SingleStress(s,8+c) = rhoDip(s,c) * deltaDUpper(s,c) & / (dUpperOld(s,c) - dLower(s,c)) -forall (t=1_pInt:4_pInt) & - deltaRhoDipole2SingleStress(1_pInt:ns,t) = -0.5_pReal & - * deltaRhoDipole2SingleStress(1_pInt:ns,(t-1_pInt)/2_pInt+9_pInt) +forall (t=1:4) & + deltaRhoDipole2SingleStress(1:ns,t) = -0.5_pReal & + * deltaRhoDipole2SingleStress(1:ns,(t-1)/2+9) !*** store new maximum dipole height in state -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & +forall (s = 1:ns, c = 1:2) & plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) plasticState(ph)%deltaState(:,of) = 0.0_pReal del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(1:ns,1:8) write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress endif @@ -1576,7 +1575,7 @@ use lattice, only: lattice_structure, & implicit none !*** input variables -integer(pInt), intent(in) :: ip, & !< current integration point +integer, intent(in) :: ip, & !< current integration point el !< current element number real(pReal), intent(in) :: Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -1587,7 +1586,7 @@ real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%n !*** local variables -integer(pInt) :: ph, & +integer :: ph, & instance, & !< current instance of this plasticity neighbor_instance, & !< instance of my neighbor's plasticity ns, & !< short notation for the total number of active slip systems @@ -1607,7 +1606,7 @@ integer(pInt) :: ph, & np,& !< neighbour phase shortcut topp, & !< type of dislocation with opposite sign to t s !< index of my current slip system -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),10) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & rho, & rhoDot, & !< density evolution rhoDotMultiplication, & !< density evolution by multiplication @@ -1615,24 +1614,24 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide) rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation rhoDotThermalAnnihilation !< density evolution by thermal annihilation -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & v, & !< current dislocation glide velocity my_v, & !< dislocation glide velocity of central ip neighbor_v, & !< dislocation glide velocity of enighboring ip gdot !< shear rates -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & tau, & !< current resolved shear stress vClimb !< climb velocity of edge dipoles -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) dLower, & !< minimum stable dipole distance for edges and screws dUpper !< current maximum stable dipole distance for edges and screws -real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & +real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & m !< direction of dislocation motion real(pReal), dimension(3,3) :: my_F, & !< my total deformation gradient neighbor_F, & !< total deformation gradient of my neighbor @@ -1660,7 +1659,7 @@ if (timestep <= 0.0_pReal) then return endif -ph = material_phase(1_pInt,ip,el) +ph = material_phase(1,ip,el) instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance),stt => state(instance)) ns = totalNslip(instance) @@ -1672,7 +1671,7 @@ rho = getRho(instance,o,ip,el) rhoSgl = rho(:,sgl) rhoDip = rho(:,dip) -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) +forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(p)%state(iV (s,t,instance),o) endforall @@ -1680,13 +1679,13 @@ endforall !**************************************************************************** !*** Calculate shear rate -forall (t = 1_pInt:4_pInt) & - gdot(1_pInt:ns,t) = rhoSgl(1_pInt:ns,t) * prm%burgers(1:ns) * v(1:ns,t) +forall (t = 1:4) & + gdot(1:ns,t) = rhoSgl(1:ns,t) * prm%burgers(1:ns) * v(1:ns,t) #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0 & .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot endif @@ -1697,7 +1696,7 @@ forall (t = 1_pInt:4_pInt) & !**************************************************************************** !*** calculate limits for stable dipole height -do s = 1_pInt,ns ! loop over slip systems +do s = 1,ns ! loop over slip systems tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,o) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -1740,7 +1739,7 @@ endif rhoDotFlux = 0.0_pReal !? why needed here -if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then ! only for nonlocal plasticity +if (.not. phase_localPlasticity(material_phase(1,ip,el))) then ! only for nonlocal plasticity !*** check CFL (Courant-Friedrichs-Lewy) condition for flux @@ -1748,7 +1747,7 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then .and. prm%CFLfactor * abs(v) * timestep & > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', & maxval(abs(v), abs(gdot) > 0.0_pReal & @@ -1771,10 +1770,10 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then m(1:3,1:ns,3) = -prm%slip_transverse m(1:3,1:ns,4) = prm%slip_transverse - my_Fe = Fe(1:3,1:3,1_pInt,ip,el) - my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1_pInt,ip,el)) + my_Fe = Fe(1:3,1:3,1,ip,el) + my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1,ip,el)) - do n = 1_pInt,theMesh%elem%nIPneighbors + do n = 1,theMesh%elem%nIPneighbors neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) @@ -1782,15 +1781,15 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then np = phaseAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el) - opposite_neighbor = n + mod(n,2_pInt) - mod(n+1_pInt,2_pInt) + opposite_neighbor = n + mod(n,2) - mod(n+1,2) opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el) opposite_ip = mesh_ipNeighborhood(2,opposite_neighbor,ip,el) opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el) - if (neighbor_n > 0_pInt) then ! if neighbor exists, average deformation gradient - neighbor_instance = phase_plasticityInstance(material_phase(1_pInt,neighbor_ip,neighbor_el)) - neighbor_Fe = Fe(1:3,1:3,1_pInt,neighbor_ip,neighbor_el) - neighbor_F = math_mul33x33(neighbor_Fe, Fp(1:3,1:3,1_pInt,neighbor_ip,neighbor_el)) + if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient + neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) + neighbor_Fe = Fe(1:3,1:3,1,neighbor_ip,neighbor_el) + neighbor_F = math_mul33x33(neighbor_Fe, Fp(1:3,1:3,1,neighbor_ip,neighbor_el)) Favg = 0.5_pReal * (my_F + neighbor_F) else ! if no neighbor, take my value as average Favg = my_F @@ -1809,14 +1808,14 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then considerEnteringFlux = .false. neighbor_v = 0.0_pReal ! needed for check of sign change in flux density below neighbor_rhoSgl = 0.0_pReal - if (neighbor_n > 0_pInt) then + if (neighbor_n > 0) then if (phase_plasticity(material_phase(1,neighbor_ip,neighbor_el)) == PLASTICITY_NONLOCAL_ID & .and. any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) & considerEnteringFlux = .true. endif if (considerEnteringFlux) then - forall (s = 1:ns, t = 1_pInt:4_pInt) + forall (s = 1:ns, t = 1:4) neighbor_v(s,t) = plasticState(np)%state(iV (s,t,neighbor_instance),no) neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance),no), & 0.0_pReal) @@ -1831,22 +1830,22 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then / math_det33(neighbor_Fe) ! interface normal in the lattice configuration of my neighbor area = mesh_ipArea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me) normal_neighbor2me = normal_neighbor2me / norm2(normal_neighbor2me) ! normalize the surface normal to unit length - do s = 1_pInt,ns - do t = 1_pInt,4_pInt - c = (t + 1_pInt) / 2 - topp = t + mod(t,2_pInt) - mod(t+1_pInt,2_pInt) + do s = 1,ns + do t = 1,4 + c = (t + 1) / 2 + topp = t + mod(t,2) - mod(t+1,2) if (neighbor_v(s,t) * math_mul3x3(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me .and. v(s,t) * neighbor_v(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density lineLength = neighbor_rhoSgl(s,t) * neighbor_v(s,t) & * math_mul3x3(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface - where (compatibility(c,1_pInt:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility... - rhoDotFlux(1_pInt:ns,t) = rhoDotFlux(1_pInt:ns,t) & + where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility... + rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) & + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type - * compatibility(c,1_pInt:ns,s,n,ip,el) ** 2.0_pReal - where (compatibility(c,1_pInt:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility... - rhoDotFlux(1_pInt:ns,topp) = rhoDotFlux(1_pInt:ns,topp) & + * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal + where (compatibility(c,1:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility... + rhoDotFlux(1:ns,topp) = rhoDotFlux(1:ns,topp) & + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type - * compatibility(c,1_pInt:ns,s,n,ip,el) ** 2.0_pReal + * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal endif enddo enddo @@ -1862,7 +1861,7 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then !* That means for an interface of zero transmissivity the leaving flux is fully converted to dead dislocations. considerLeavingFlux = .true. - if (opposite_n > 0_pInt) then + if (opposite_n > 0) then if (phase_plasticity(material_phase(1,opposite_ip,opposite_el)) /= PLASTICITY_NONLOCAL_ID) & considerLeavingFlux = .false. endif @@ -1878,19 +1877,19 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then / math_det33(my_Fe) ! interface normal in my lattice configuration area = mesh_ipArea(n,ip,el) * norm2(normal_me2neighbor) normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length - do s = 1_pInt,ns - do t = 1_pInt,4_pInt - c = (t + 1_pInt) / 2_pInt + do s = 1,ns + do t = 1,4 + c = (t + 1) / 2 if (my_v(s,t) * math_mul3x3(m(1:3,s,t), normal_me2neighbor) > 0.0_pReal ) then ! flux from me to my neighbor == leaving flux for me (might also be a pure flux from my mobile density to dead density if interface not at all transmissive) if (my_v(s,t) * neighbor_v(s,t) >= 0.0_pReal) then ! no sign change in flux density - transmissivity = sum(compatibility(c,1_pInt:ns,s,n,ip,el)**2.0_pReal) ! overall transmissivity from this slip system to my neighbor + transmissivity = sum(compatibility(c,1:ns,s,n,ip,el)**2.0_pReal) ! overall transmissivity from this slip system to my neighbor else ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor transmissivity = 0.0_pReal endif lineLength = my_rhoSgl(s,t) * my_v(s,t) & * math_mul3x3(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / mesh_ipVolume(ip,el) ! subtract dislocation flux from current type - rhoDotFlux(s,t+4_pInt) = rhoDotFlux(s,t+4_pInt) & + rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) & + lineLength / mesh_ipVolume(ip,el) * (1.0_pReal - transmissivity) & * sign(1.0_pReal, my_v(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point endif @@ -1908,7 +1907,7 @@ endif !*** formation by glide -do c = 1_pInt,2_pInt +do c = 1,2 rhoDotSingle2DipoleGlide(1:ns,2*c-1) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile @@ -1936,15 +1935,15 @@ enddo rhoDotAthermalAnnihilation = 0.0_pReal -forall (c=1_pInt:2_pInt) & - rhoDotAthermalAnnihilation(1:ns,c+8_pInt) = -2.0_pReal * dLower(1:ns,c) / prm%burgers(1:ns) & +forall (c=1:2) & + rhoDotAthermalAnnihilation(1:ns,c+8) = -2.0_pReal * dLower(1:ns,c) / prm%burgers(1:ns) & * ( 2.0_pReal * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1))) & ! was single hitting single + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent ! annihilated screw dipoles leave edge jogs behind on the colinear system if (lattice_structure(ph) == LATTICE_fcc_ID) & - forall (s = 1:ns, prm%colinearSystem(s) > 0_pInt) & + forall (s = 1:ns, prm%colinearSystem(s) > 0) & rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & * 0.25_pReal * sqrt(stt%rho_forest(s,o)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor @@ -1957,7 +1956,7 @@ selfDiffusion = prm%Dsd0 * exp(-prm%selfDiffusionEnergy / (KB * Temperature)) vClimb = prm%atomicVolume * selfDiffusion / ( KB * Temperature ) & * prm%mu / ( 2.0_pReal * PI * (1.0_pReal-prm%nu) ) & * 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) ) -forall (s = 1_pInt:ns, dUpper(s,1) > dLower(s,1)) & +forall (s = 1:ns, dUpper(s,1) > dLower(s,1)) & rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), & - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have @@ -1984,9 +1983,9 @@ results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', & rhoDotMultiplication(1:ns,1:4) * timestep write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', & @@ -2010,7 +2009,7 @@ results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation if ( any(rho(:,mob) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & .or. any(rho(:,dip) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip write(6,'(a)') '<< CONST >> enforcing cutback !!!' endif @@ -2018,12 +2017,12 @@ if ( any(rho(:,mob) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & plasticState(p)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) return else - forall (s = 1:ns, t = 1_pInt:4_pInt) + forall (s = 1:ns, t = 1:4) plasticState(p)%dotState(iRhoU(s,t,instance),o) = rhoDot(s,t) - plasticState(p)%dotState(iRhoB(s,t,instance),o) = rhoDot(s,t+4_pInt) + plasticState(p)%dotState(iRhoB(s,t,instance),o) = rhoDot(s,t+4) endforall - forall (s = 1:ns, c = 1_pInt:2_pInt) & - plasticState(p)%dotState(iRhoD(s,c,instance),o) = rhoDot(s,c+8_pInt) + forall (s = 1:ns, c = 1:2) & + plasticState(p)%dotState(iRhoD(s,c,instance),o) = rhoDot(s,c+8) forall (s = 1:ns) & dot%accumulatedshear(s,o) = sum(gdot(s,1:4)) endif @@ -2053,13 +2052,13 @@ use lattice, only: lattice_qDisorientation implicit none !* input variables -integer(pInt), intent(in) :: i, & ! ip index +integer, intent(in) :: i, & ! ip index e ! element index type(rotation), dimension(1,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & orientation ! crystal orientation in quaternions !* local variables -integer(pInt) Nneighbors, & ! number of neighbors +integer Nneighbors, & ! number of neighbors n, & ! neighbor index neighbor_e, & ! element index of my neighbor neighbor_i, & ! integration point index of my neighbor @@ -2093,11 +2092,11 @@ associate(prm => param(instance)) !*** start out fully compatible my_compatibility = 0.0_pReal -forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal +forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal !*** Loop thrugh neighbors and check whether there is any my_compatibility. -neighbors: do n = 1_pInt,Nneighbors +neighbors: do n = 1,Nneighbors neighbor_e = mesh_ipNeighborhood(1,n,i,e) neighbor_i = mesh_ipNeighborhood(2,n,i,e) @@ -2105,8 +2104,8 @@ neighbors: do n = 1_pInt,Nneighbors !* FREE SURFACE !* Set surface transmissivity to the value specified in the material.config - if (neighbor_e <= 0_pInt .or. neighbor_i <= 0_pInt) then - forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,n) = sqrt(prm%surfaceTransmissivity) + if (neighbor_e <= 0 .or. neighbor_i <= 0) then + forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,n) = sqrt(prm%surfaceTransmissivity) cycle endif @@ -2120,7 +2119,7 @@ neighbors: do n = 1_pInt,Nneighbors neighbor_phase = material_phase(1,neighbor_i,neighbor_e) if (neighbor_phase /= ph) then if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph))& - forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,n) = 0.0_pReal + forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,n) = 0.0_pReal cycle endif @@ -2132,7 +2131,7 @@ neighbors: do n = 1_pInt,Nneighbors neighbor_textureID = material_texture(1,neighbor_i,neighbor_e) if (neighbor_textureID /= textureID) then if (.not. phase_localPlasticity(neighbor_phase)) then - forall(s1 = 1_pInt:ns) & + forall(s1 = 1:ns) & my_compatibility(1:2,s1,s1,n) = sqrt(prm%grainboundaryTransmissivity) endif cycle @@ -2151,8 +2150,8 @@ neighbors: do n = 1_pInt,Nneighbors else rot = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e)) absoluteMisorientation = rot%asQuaternion() - mySlipSystems: do s1 = 1_pInt,ns - neighborSlipSystems: do s2 = 1_pInt,ns + mySlipSystems: do s1 = 1,ns + neighborSlipSystems: do s2 = 1,ns my_compatibility(1,s2,s1,n) = math_mul3x3(prm%slip_normal(1:3,s1), & math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2))) & * abs(math_mul3x3(prm%slip_direction(1:3,s1), & @@ -2203,14 +2202,14 @@ function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) implicit none real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point el !< element - real(pReal), dimension(sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(material_phase(1_pInt,ip,el))))) :: & + real(pReal), dimension(sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(material_phase(1,ip,el))))) :: & postResults - integer(pInt) :: & + integer :: & ph, & instance, & !< current instance of this plasticity ns, & !< short notation for the total number of active slip systems @@ -2221,13 +2220,13 @@ function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) t, & !< type of dislocation s !< index of my current slip system - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & rhoSgl, & rhoDotSgl !< evolution rate of single dislocation densities (positive/negative screw and edge without dipoles) - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & gdot, & !< shear rates v !< velocities - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & rhoDotDip !< evolution rate of dipole dislocation densities (screw and edge dipoles) @@ -2236,166 +2235,166 @@ of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) ns = totalNslip(instance) -cs = 0_pInt +cs = 0 associate(prm => param(instance),dst => microstructure(instance),stt=>state(instance)) !* short hand notations for state variables -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t+4_pInt) = plasticState(ph)%State(iRhoB(s,t,instance),of) +forall (s = 1:ns, t = 1:4) + rhoSgl(s,t+4) = plasticState(ph)%State(iRhoB(s,t,instance),of) v(s,t) = plasticState(ph)%State(iV(s,t,instance),of) - rhoDotSgl(s,t+4_pInt) = plasticState(ph)%dotState(iRhoB(s,t,instance),of) + rhoDotSgl(s,t+4) = plasticState(ph)%dotState(iRhoB(s,t,instance),of) endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) +forall (s = 1:ns, c = 1:2) rhoDotDip(s,c) = plasticState(ph)%dotState(iRhoD(s,c,instance),of) endforall !* Calculate shear rate -forall (t = 1_pInt:4_pInt) & +forall (t = 1:4) & gdot(1:ns,t) = rhoSgl(1:ns,t) * prm%burgers(1:ns) * v(1:ns,t) !* calculate limits for stable dipole height -outputsLoop: do o = 1_pInt,size(param(instance)%outputID) +outputsLoop: do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (rho_sgl_mob_edg_pos_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_edg_pos(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_mob_edg_pos(:,of) cs = cs + ns case (rho_sgl_imm_edg_pos_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_edg_pos(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_imm_edg_pos(:,of) cs = cs + ns case (rho_sgl_mob_edg_neg_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_edg_neg(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_mob_edg_neg(:,of) cs = cs + ns case (rho_sgl_imm_edg_neg_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_edg_neg(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_imm_edg_neg(:,of) cs = cs + ns case (rho_dip_edg_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_dip_edg(:,of) + postResults(cs+1:cs+ns) = stt%rho_dip_edg(:,of) cs = cs + ns case (rho_sgl_mob_scr_pos_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_scr_pos(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_mob_scr_pos(:,of) cs = cs + ns case (rho_sgl_imm_scr_pos_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_scr_pos(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_imm_scr_pos(:,of) cs = cs + ns case (rho_sgl_mob_scr_neg_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_mob_scr_neg(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_mob_scr_neg(:,of) cs = cs + ns case (rho_sgl_imm_scr_neg_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_sgl_imm_scr_neg(:,of) + postResults(cs+1:cs+ns) = stt%rho_sgl_imm_scr_neg(:,of) cs = cs + ns case (rho_dip_scr_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_dip_scr(:,of) + postResults(cs+1:cs+ns) = stt%rho_dip_scr(:,of) cs = cs + ns case (rho_forest_ID) - postResults(cs+1_pInt:cs+ns) = stt%rho_forest(:,of) + postResults(cs+1:cs+ns) = stt%rho_forest(:,of) cs = cs + ns case (shearrate_ID) - postResults(cs+1_pInt:cs+ns) = sum(gdot,2) + postResults(cs+1:cs+ns) = sum(gdot,2) cs = cs + ns case (resolvedstress_back_ID) - postResults(cs+1_pInt:cs+ns) = dst%tau_back(:,of) + postResults(cs+1:cs+ns) = dst%tau_back(:,of) cs = cs + ns case (resistance_ID) - postResults(cs+1_pInt:cs+ns) = dst%tau_Threshold(:,of) + postResults(cs+1:cs+ns) = dst%tau_Threshold(:,of) cs = cs + ns case (rho_dot_sgl_ID) - postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & + postResults(cs+1:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) cs = cs + ns case (rho_dot_sgl_mobile_ID) - postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) + postResults(cs+1:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) cs = cs + ns case (rho_dot_dip_ID) - postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) + postResults(cs+1:cs+ns) = sum(rhoDotDip,2) cs = cs + ns case (rho_dot_gen_edge_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,1,of) + postResults(cs+1:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,1,of) cs = cs + ns case (rho_dot_gen_screw_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,2,of) + postResults(cs+1:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,2,of) cs = cs + ns case (rho_dot_sgl2dip_edge_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotSingle2DipoleGlide(1:ns,1,of) + postResults(cs+1:cs+ns) = results(instance)%rhoDotSingle2DipoleGlide(1:ns,1,of) cs = cs + ns case (rho_dot_sgl2dip_screw_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotSingle2DipoleGlide(1:ns,2,of) + postResults(cs+1:cs+ns) = results(instance)%rhoDotSingle2DipoleGlide(1:ns,2,of) cs = cs + ns case (rho_dot_ann_ath_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotAthermalAnnihilation(1:ns,1,of) & + postResults(cs+1:cs+ns) = results(instance)%rhoDotAthermalAnnihilation(1:ns,1,of) & + results(instance)%rhoDotAthermalAnnihilation(1:ns,2,of) cs = cs + ns case (rho_dot_ann_the_edge_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotThermalAnnihilation(1:ns,1,of) + postResults(cs+1:cs+ns) = results(instance)%rhoDotThermalAnnihilation(1:ns,1,of) cs = cs + ns case (rho_dot_ann_the_screw_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotThermalAnnihilation(1:ns,2,of) + postResults(cs+1:cs+ns) = results(instance)%rhoDotThermalAnnihilation(1:ns,2,of) cs = cs + ns case (rho_dot_edgejogs_ID) - postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotEdgeJogs(1:ns,of) + postResults(cs+1:cs+ns) = results(instance)%rhoDotEdgeJogs(1:ns,of) cs = cs + ns case (rho_dot_flux_mobile_ID) - postResults(cs+1_pInt:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,1:4,of),2) + postResults(cs+1:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,1:4,of),2) cs = cs + ns case (rho_dot_flux_edge_ID) - postResults(cs+1_pInt:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,1:2,of),2) & + postResults(cs+1:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,1:2,of),2) & + sum(results(instance)%rhoDotFlux(1:ns,5:6,of)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) cs = cs + ns case (rho_dot_flux_screw_ID) - postResults(cs+1_pInt:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,3:4,of),2) & + postResults(cs+1:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,3:4,of),2) & + sum(results(instance)%rhoDotFlux(1:ns,7:8,of)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) cs = cs + ns case (velocity_edge_pos_ID) - postResults(cs+1_pInt:cs+ns) = v(1:ns,1) + postResults(cs+1:cs+ns) = v(1:ns,1) cs = cs + ns case (velocity_edge_neg_ID) - postResults(cs+1_pInt:cs+ns) = v(1:ns,2) + postResults(cs+1:cs+ns) = v(1:ns,2) cs = cs + ns case (velocity_screw_pos_ID) - postResults(cs+1_pInt:cs+ns) = v(1:ns,3) + postResults(cs+1:cs+ns) = v(1:ns,3) cs = cs + ns case (velocity_screw_neg_ID) - postResults(cs+1_pInt:cs+ns) = v(1:ns,4) + postResults(cs+1:cs+ns) = v(1:ns,4) cs = cs + ns case(accumulatedshear_ID) - postResults(cs+1_pInt:cs+ns) = stt%accumulatedshear(:,of) + postResults(cs+1:cs+ns) = stt%accumulatedshear(:,of) cs = cs + ns end select @@ -2439,7 +2438,7 @@ subroutine plastic_nonlocal_results(instance,group) integer :: o associate(prm => param(instance), stt => state(instance)) - outputsLoop: do o = 1_pInt,size(prm%outputID) + outputsLoop: do o = 1,size(prm%outputID) select case(prm%outputID(o)) end select enddo outputsLoop From dac4f5cd22c78d6ef0bca09d2879571b69d0c685 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 17:02:08 +0100 Subject: [PATCH 13/19] syntax polishing --- src/constitutive.f90 | 16 +- src/plastic_nonlocal.f90 | 3278 +++++++++++++++++++------------------- 2 files changed, 1632 insertions(+), 1662 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 407b3b684..dfe8679c3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1042,40 +1042,34 @@ function constitutive_postResults(S, Fi, ipc, ip, el) startPos = 1_pInt endPos = plasticState(material_phase(ipc,ip,el))%sizePostResults + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_postResults(startPos:endPos) = & plastic_isotropic_postResults(Mp,instance,of) 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 - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_postResults(startPos:endPos) = & plastic_kinehardening_postResults(Mp,instance,of) case (PLASTICITY_DISLOTWIN_ID) plasticityType - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_postResults(startPos:endPos) = & plastic_dislotwin_postResults(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_postResults(startPos:endPos) = & plastic_disloucla_postResults(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType constitutive_postResults(startPos:endPos) = & - plastic_nonlocal_postResults (Mp,ip,el) + plastic_nonlocal_postResults (material_phase(ipc,ip,el),instance,of) + end select plasticityType SourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 88f8d0ec9..33c770f06 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -5,240 +5,228 @@ !> @brief material subroutine for plasticity including dislocation flux !-------------------------------------------------------------------------------------------------- module plastic_nonlocal - use prec, only: & - pReal + use prec, only: & + pReal + + implicit none + private + real(pReal), parameter, private :: & + KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin - implicit none - private - real(pReal), parameter, private :: & - KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin - - integer, dimension(:,:), allocatable, target, public :: & - plastic_nonlocal_sizePostResult !< size of each post result output + integer, dimension(:,:), allocatable, target, public :: & + plastic_nonlocal_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_nonlocal_output !< name of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_nonlocal_output !< name of each post result output + ! storage order of dislocation types integer, dimension(8), parameter :: & - sgl = [1,2,3,4,5,6,7,8] + sgl = [1,2,3,4,5,6,7,8] !< signed (single) integer, dimension(5), parameter :: & - edg = [1,2,5,6,9], & - scr = [3,4,7,8,10] + edg = [1,2,5,6,9], & !< edge + scr = [3,4,7,8,10] !< screw integer, dimension(4), parameter :: & - mob = [1,2,3,4], & - imm = [5,6,7,8], & - pos = sgl(1:7:2), & - neg = sgl(2:8:2), & - sgl_edg = edg(1:4), & - sgl_scr = scr(1:4) - integer, parameter :: & - mob_edg_pos = 1, & - mob_edg_neg = 2, & - mob_scr_pos = 3, & - mob_scr_neg = 4 + mob = [1,2,3,4], & !< mobile + imm = [5,6,7,8] !< immobile (blocked) integer, dimension(2), parameter :: & - dip = [9,10], & - imm_edg = imm(1:2), & - imm_scr = imm(3:4) + dip = [9,10], & !< dipole + imm_edg = imm(1:2), & !< immobile edge + imm_scr = imm(3:4) !< immobile screw + integer, parameter :: & + mob_edg_pos = 1, & !< mobile edge positive + mob_edg_neg = 2, & !< mobile edge negative + mob_scr_pos = 3, & !< mobile screw positive + mob_scr_neg = 4 !< mobile screw positive - integer, dimension(:,:,:), allocatable, private :: & - iRhoU, & !< state indices for unblocked density - iRhoB, & !< state indices for blocked density - iRhoD, & !< state indices for dipole density - iV, & !< state indices for dislcation velocities - iD !< state indices for stable dipole height - - integer, dimension(:), allocatable, private, protected :: & - totalNslip !< total number of active slip systems for each instance - - real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & - compatibility !< slip system compatibility between me and my neighbors - - enum, bind(c) - enumerator :: undefined_ID, & - rho_sgl_mob_edg_pos_ID, & - rho_sgl_mob_edg_neg_ID, & - rho_sgl_mob_scr_pos_ID, & - rho_sgl_mob_scr_neg_ID, & - rho_sgl_imm_edg_pos_ID, & - rho_sgl_imm_edg_neg_ID, & - rho_sgl_imm_scr_pos_ID, & - rho_sgl_imm_scr_neg_ID, & - rho_dip_edg_ID, & - rho_dip_scr_ID, & - rho_forest_ID, & - shearrate_ID, & - resolvedstress_back_ID, & - resistance_ID, & - rho_dot_sgl_ID, & - rho_dot_sgl_mobile_ID, & - rho_dot_dip_ID, & - rho_dot_gen_edge_ID, & - rho_dot_gen_screw_ID, & - rho_dot_sgl2dip_edge_ID, & - rho_dot_sgl2dip_screw_ID, & - rho_dot_ann_ath_ID, & - rho_dot_ann_the_edge_ID, & - rho_dot_ann_the_screw_ID, & - rho_dot_edgejogs_ID, & - rho_dot_flux_mobile_ID, & - rho_dot_flux_edge_ID, & - rho_dot_flux_screw_ID, & - velocity_edge_pos_ID, & - velocity_edge_neg_ID, & - velocity_screw_pos_ID, & - velocity_screw_neg_ID, & - accumulatedshear_ID - end enum - - type, private :: tParameters !< container type for internal constitutive parameters - - real(pReal) :: & - atomicVolume, & !< atomic volume - Dsd0, & !< prefactor for self-diffusion coefficient - selfDiffusionEnergy, & !< activation enthalpy for diffusion - aTolRho, & !< absolute tolerance for dislocation density in state integration - aTolShear, & !< absolute tolerance for accumulated shear in state integration - significantRho, & !< density considered significant - significantN, & !< number of dislocations considered significant - doublekinkwidth, & !< width of a doubkle kink in multiples of the burgers vector length b - solidSolutionEnergy, & !< activation energy for solid solution in J - solidSolutionSize, & !< solid solution obstacle size in multiples of the burgers vector length - solidSolutionConcentration, & !< concentration of solid solution in atomic parts - p, & !< parameter for kinetic law (Kocks,Argon,Ashby) - q, & !< parameter for kinetic law (Kocks,Argon,Ashby) - viscosity, & !< viscosity for dislocation glide in Pa s - fattack, & !< attack frequency in Hz - rhoSglScatter, & !< standard deviation of scatter in initial dislocation density - surfaceTransmissivity, & !< transmissivity at free surface - grainboundaryTransmissivity, & !< transmissivity at grain boundary (identified by different texture) - CFLfactor, & !< safety factor for CFL flux condition - fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) - rhoSglRandom, & - rhoSglRandomBinning, & - linetensionEffect, & - edgeJogFactor, & - mu, & - nu - - real(pReal), dimension(:), allocatable :: & - minDipoleHeight_edge, & !< minimum stable edge dipole height - minDipoleHeight_screw, & !< minimum stable screw dipole height + ! BEGIN DEPRECATES + integer, dimension(:,:,:), allocatable, private :: & + iRhoU, & !< state indices for unblocked density + iRhoB, & !< state indices for blocked density + iRhoD, & !< state indices for dipole density + iV, & !< state indices for dislcation velocities + iD !< state indices for stable dipole height + integer, dimension(:), allocatable, private, protected :: & + totalNslip !< total number of active slip systems for each instance + !END DEPRECATED + + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & + compatibility !< slip system compatibility between me and my neighbors + + enum, bind(c) + enumerator :: & + undefined_ID, & + rho_sgl_mob_edg_pos_ID, & + rho_sgl_mob_edg_neg_ID, & + rho_sgl_mob_scr_pos_ID, & + rho_sgl_mob_scr_neg_ID, & + rho_sgl_imm_edg_pos_ID, & + rho_sgl_imm_edg_neg_ID, & + rho_sgl_imm_scr_pos_ID, & + rho_sgl_imm_scr_neg_ID, & + rho_dip_edg_ID, & + rho_dip_scr_ID, & + rho_forest_ID, & + shearrate_ID, & + resolvedstress_back_ID, & + resistance_ID, & + rho_dot_sgl_ID, & + rho_dot_sgl_mobile_ID, & + rho_dot_dip_ID, & + rho_dot_gen_edge_ID, & + rho_dot_gen_screw_ID, & + rho_dot_sgl2dip_edge_ID, & + rho_dot_sgl2dip_screw_ID, & + rho_dot_ann_ath_ID, & + rho_dot_ann_the_edge_ID, & + rho_dot_ann_the_screw_ID, & + rho_dot_edgejogs_ID, & + rho_dot_flux_mobile_ID, & + rho_dot_flux_edge_ID, & + rho_dot_flux_screw_ID, & + velocity_edge_pos_ID, & + velocity_edge_neg_ID, & + velocity_screw_pos_ID, & + velocity_screw_neg_ID, & + accumulatedshear_ID + end enum + + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + atomicVolume, & !< atomic volume + Dsd0, & !< prefactor for self-diffusion coefficient + selfDiffusionEnergy, & !< activation enthalpy for diffusion + aTolRho, & !< absolute tolerance for dislocation density in state integration + aTolShear, & !< absolute tolerance for accumulated shear in state integration + significantRho, & !< density considered significant + significantN, & !< number of dislocations considered significant + doublekinkwidth, & !< width of a doubkle kink in multiples of the burgers vector length b + solidSolutionEnergy, & !< activation energy for solid solution in J + solidSolutionSize, & !< solid solution obstacle size in multiples of the burgers vector length + solidSolutionConcentration, & !< concentration of solid solution in atomic parts + p, & !< parameter for kinetic law (Kocks,Argon,Ashby) + q, & !< parameter for kinetic law (Kocks,Argon,Ashby) + viscosity, & !< viscosity for dislocation glide in Pa s + fattack, & !< attack frequency in Hz + rhoSglScatter, & !< standard deviation of scatter in initial dislocation density + surfaceTransmissivity, & !< transmissivity at free surface + grainboundaryTransmissivity, & !< transmissivity at grain boundary (identified by different texture) + CFLfactor, & !< safety factor for CFL flux condition + fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) + rhoSglRandom, & + rhoSglRandomBinning, & + linetensionEffect, & + edgeJogFactor, & + mu, & + nu + real(pReal), dimension(:), allocatable :: & + minDipoleHeight_edge, & !< minimum stable edge dipole height + minDipoleHeight_screw, & !< minimum stable screw dipole height peierlsstress_edge, & peierlsstress_screw, & - rhoSglEdgePos0, & !< initial edge_pos dislocation density - rhoSglEdgeNeg0, & !< initial edge_neg dislocation density - rhoSglScrewPos0, & !< initial screw_pos dislocation density - rhoSglScrewNeg0, & !< initial screw_neg dislocation density - rhoDipEdge0, & !< initial edge dipole dislocation density - rhoDipScrew0,& !< initial screw dipole dislocation density - lambda0, & !< mean free path prefactor for each - burgers !< absolute length of burgers vector [m] - real(pReal), dimension(:,:), allocatable :: & - slip_normal, & - slip_direction, & - slip_transverse, & - minDipoleHeight, & ! edge and screw - peierlsstress, & ! edge and screw - interactionSlipSlip ,& !< coefficients for slip-slip interaction - forestProjection_Edge, & !< matrix of forest projections of edge dislocations - forestProjection_Screw !< matrix of forest projections of screw dislocations - real(pReal), dimension(:), allocatable, private :: & - nonSchmidCoeff - integer :: totalNslip - - real(pReal), dimension(:,:,:), allocatable, private :: & - Schmid, & !< Schmid contribution - nonSchmid_pos, & - nonSchmid_neg !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) - - integer , dimension(:) ,allocatable , public:: & - Nslip,& - colinearSystem !< colinear system to the active slip system (only valid for fcc!) - - logical, private :: & - shortRangeStressCorrection, & !< flag indicating the use of the short range stress correction by a excess density gradient term - probabilisticMultiplication - - integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID !< ID of each post result output - - end type tParameters - - type, private :: tNonlocalMicrostructure - real(pReal), allocatable, dimension(:,:) :: & - tau_Threshold, & - tau_Back - - end type tNonlocalMicrostructure + rhoSglEdgePos0, & !< initial edge_pos dislocation density + rhoSglEdgeNeg0, & !< initial edge_neg dislocation density + rhoSglScrewPos0, & !< initial screw_pos dislocation density + rhoSglScrewNeg0, & !< initial screw_neg dislocation density + rhoDipEdge0, & !< initial edge dipole dislocation density + rhoDipScrew0,& !< initial screw dipole dislocation density + lambda0, & !< mean free path prefactor for each + burgers !< absolute length of burgers vector [m] + real(pReal), dimension(:,:), allocatable :: & + slip_normal, & + slip_direction, & + slip_transverse, & + minDipoleHeight, & ! edge and screw + peierlsstress, & ! edge and screw + interactionSlipSlip ,& !< coefficients for slip-slip interaction + forestProjection_Edge, & !< matrix of forest projections of edge dislocations + forestProjection_Screw !< matrix of forest projections of screw dislocations + real(pReal), dimension(:), allocatable, private :: & + nonSchmidCoeff + real(pReal), dimension(:,:,:), allocatable, private :: & + Schmid, & !< Schmid contribution + nonSchmid_pos, & + nonSchmid_neg !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) + integer :: & + totalNslip + integer, dimension(:) ,allocatable , public:: & + Nslip,& + colinearSystem !< colinear system to the active slip system (only valid for fcc!) - type, private :: tOutput !< container type for storage of output results - real(pReal), dimension(:,:), allocatable, private :: & - rhoDotEdgeJogs - real(pReal), dimension(:,:,:), allocatable, private :: & - rhoDotFlux, & - rhoDotMultiplication, & - rhoDotSingle2DipoleGlide, & - rhoDotAthermalAnnihilation, & - rhoDotThermalAnnihilation - end type + logical, private :: & + shortRangeStressCorrection, & !< flag indicating the use of the short range stress correction by a excess density gradient term + probabilisticMultiplication + + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID !< ID of each post result output + + end type tParameters + + type, private :: tNonlocalMicrostructure + real(pReal), allocatable, dimension(:,:) :: & + tau_Threshold, & + tau_Back + end type tNonlocalMicrostructure + + type, private :: tOutput !< container type for storage of output results + real(pReal), dimension(:,:), allocatable, private :: & + rhoDotEdgeJogs + real(pReal), dimension(:,:,:), allocatable, private :: & + rhoDotFlux, & + rhoDotMultiplication, & + rhoDotSingle2DipoleGlide, & + rhoDotAthermalAnnihilation, & + rhoDotThermalAnnihilation + end type tOutput + - type, private :: tNonlocalState - - real(pReal), pointer, dimension(:,:) :: & - rho, & ! < all dislocations - rhoSgl, & - rhoSglMobile, & ! iRhoU - rho_sgl_mob_edg_pos, & - rho_sgl_mob_edg_neg, & - rho_sgl_mob_scr_pos, & - rho_sgl_mob_scr_neg, & - rhoSglImmobile, & ! iRhoB - rho_sgl_imm_edg_pos, & - rho_sgl_imm_edg_neg, & - rho_sgl_imm_scr_pos, & - rho_sgl_imm_scr_neg, & - rhoSglPos, & - rhoSglMobilePos, & - rhoSglImmobilePos, & - rhoSglNeg, & - rhoSglMobileNeg, & - rhoSglImmobileNeg, & - rhoDip, & ! iRhoD - rho_dip_edg, & - rho_dip_scr, & - rhoSglScrew, & - rhoSglEdge, & - rho_forest, & - accumulatedshear - end type tNonlocalState - + real(pReal), pointer, dimension(:,:) :: & + rho, & ! < all dislocations + rhoSgl, & + rhoSglMobile, & ! iRhoU + rho_sgl_mob_edg_pos, & + rho_sgl_mob_edg_neg, & + rho_sgl_mob_scr_pos, & + rho_sgl_mob_scr_neg, & + rhoSglImmobile, & ! iRhoB + rho_sgl_imm_edg_pos, & + rho_sgl_imm_edg_neg, & + rho_sgl_imm_scr_pos, & + rho_sgl_imm_scr_neg, & + rhoDip, & ! iRhoD + rho_dip_edg, & + rho_dip_scr, & + rho_forest, & + accumulatedshear, & + v + end type tNonlocalState + type(tNonlocalState), allocatable, dimension(:), private :: & - deltaState, & - dotState, & - state - - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - + deltaState, & + dotState, & + state + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tOutput), dimension(:), allocatable, private :: results type(tNonlocalMicrostructure), dimension(:), allocatable, private :: microstructure - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_nonlocal_outputID !< ID of each post result output - - public :: & - plastic_nonlocal_init, & - plastic_nonlocal_dependentState, & - plastic_nonlocal_LpAndItsTangent, & - plastic_nonlocal_dotState, & - plastic_nonlocal_deltaState, & - plastic_nonlocal_updateCompatibility, & - plastic_nonlocal_postResults, & - plastic_nonlocal_results - - private :: & - plastic_nonlocal_kinetics + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_nonlocal_outputID !< ID of each post result output + + public :: & + plastic_nonlocal_init, & + plastic_nonlocal_dependentState, & + plastic_nonlocal_LpAndItsTangent, & + plastic_nonlocal_dotState, & + plastic_nonlocal_deltaState, & + plastic_nonlocal_updateCompatibility, & + plastic_nonlocal_postResults, & + plastic_nonlocal_results + + private :: & + plastic_nonlocal_kinetics contains @@ -273,19 +261,19 @@ subroutine plastic_nonlocal_init implicit none character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - integer, dimension(0), parameter :: emptyIntArray = [integer::] + integer, dimension(0), parameter :: emptyIntArray = [integer::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] integer :: & + sizeState, sizeDotState,sizeDependentState, sizeDeltaState, & maxNinstances, & p, i, & l, & s1, s2, & - s, & ! index of my slip system - t, & ! index of dislocation type - c ! index of dislocation character + s, & + t, & + c - integer :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState integer(kind(undefined_ID)) :: & outputID character(len=512) :: & @@ -302,7 +290,7 @@ subroutine plastic_nonlocal_init write(6,'(/,a)') ' Kords, Dissertation RWTH Aachen, 2014' write(6,'(a)') ' http://publications.rwth-aachen.de/record/229993' - maxNinstances = count(phase_plasticity == PLASTICITY_NONLOCAL_ID) + maxNinstances = count(phase_plasticity == PLASTICITY_NONLOCAL_ID) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances @@ -311,18 +299,19 @@ subroutine plastic_nonlocal_init allocate(state(maxNinstances)) allocate(dotState(maxNinstances)) allocate(deltaState(maxNinstances)) - allocate(microstructure(maxNinstances)) + allocate(microstructure(maxNinstances)) allocate(results(maxNinstances)) allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0) allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) plastic_nonlocal_output = '' - allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) - allocate(totalNslip(maxNinstances), source=0) + allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) + allocate(totalNslip(maxNinstances), source=0) do p=1, size(config_phase) if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle + associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & @@ -417,8 +406,8 @@ subroutine plastic_nonlocal_init prm%CFLfactor = config%getFloat('cflfactor',defaultVal=2.0_pReal) prm%atomicVolume = config%getFloat('atomicvolume') - prm%Dsd0 = config%getFloat('selfdiffusionprefactor') !,'dsd0') - prm%selfDiffusionEnergy = config%getFloat('selfdiffusionenergy') !,'qsd') + prm%Dsd0 = config%getFloat('selfdiffusionprefactor') !,'dsd0' + prm%selfDiffusionEnergy = config%getFloat('selfdiffusionenergy') !,'qsd' prm%linetensionEffect = config%getFloat('linetension') prm%edgeJogFactor = config%getFloat('edgejog')!,'edgejogs' prm%doublekinkwidth = config%getFloat('doublekinkwidth') @@ -488,13 +477,11 @@ subroutine plastic_nonlocal_init if (prm%surfaceTransmissivity < 0.0_pReal .or. prm%surfaceTransmissivity > 1.0_pReal) & extmsg = trim(extmsg)//' surfaceTransmissivity' - if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & -extmsg = trim(extmsg)//' fEdgeMultiplication' + if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & + extmsg = trim(extmsg)//' fEdgeMultiplication' endif slipActive -!-------------------------------------------------------------------------------------------------- -! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1, size(outputs) @@ -585,508 +572,502 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' 'rhoSglScrewPosImmobile','rhoSglScrewNegImmobile', & 'rhoDipEdge ','rhoDipScrew ', & 'accumulatedshear ' ]) * prm%totalNslip !< "basic" microstructural state variables that are independent from other state variables - sizeDependentState = size([ 'rhoForest '])) * prm%totalNslip !< microstructural state variables that depend on other state variables + sizeDependentState = size([ 'rhoForest ']) * prm%totalNslip !< microstructural state variables that depend on other state variables sizeState = sizeDotState + sizeDependentState & + size([ 'velocityEdgePos ','velocityEdgeNeg ', & 'velocityScrewPos ','velocityScrewNeg ', & - 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]) * prm%totalNslip !< other dependent state variables that are not updated by microstructure + 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]) * prm%totalNslip !< other dependent state variables that are not updated by microstructure sizeDeltaState = sizeDotState call material_allocatePlasticState(p,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & prm%totalNslip,0,0) plasticState(p)%nonlocal = .true. - plasticState(p)%offsetDeltaState = 0 ! ToDo: state structure does not follow convention + plasticState(p)%offsetDeltaState = 0 ! ToDo: state structure does not follow convention plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(p))) totalNslip(phase_plasticityInstance(p)) = prm%totalNslip - ! ToDo: Not really sure if this large number of mostly overlapping pointers is useful - stt%rho => plasticState(p)%state (0*prm%totalNslip+1:10*prm%totalNslip,:) - dot%rho => plasticState(p)%dotState (0*prm%totalNslip+1:10*prm%totalNslip,:) - del%rho => plasticState(p)%deltaState (0*prm%totalNslip+1:10*prm%totalNslip,:) - plasticState(p)%aTolState(1:10*prm%totalNslip) = prm%aTolRho - - stt%rhoSglEdge => plasticState(p)%state (0*prm%totalNslip+1:06*prm%totalNslip:2*prm%totalNslip,:) - stt%rhoSglScrew => plasticState(p)%state (2*prm%totalNslip+1:08*prm%totalNslip:2*prm%totalNslip,:) - - stt%rhoSgl => plasticState(p)%state (0*prm%totalNslip+1: 8*prm%totalNslip,:) - dot%rhoSgl => plasticState(p)%dotState (0*prm%totalNslip+1: 8*prm%totalNslip,:) - del%rhoSgl => plasticState(p)%deltaState (0*prm%totalNslip+1: 8*prm%totalNslip,:) - - stt%rhoSglMobile => plasticState(p)%state (0*prm%totalNslip+1: 4*prm%totalNslip,:) - dot%rhoSglMobile => plasticState(p)%dotState (0*prm%totalNslip+1: 4*prm%totalNslip,:) - del%rhoSglMobile => plasticState(p)%deltaState (0*prm%totalNslip+1: 4*prm%totalNslip,:) - - stt%rho_sgl_mob_edg_pos => plasticState(p)%state (0*prm%totalNslip+1: 1*prm%totalNslip,:) - dot%rho_sgl_mob_edg_pos => plasticState(p)%dotState (0*prm%totalNslip+1: 1*prm%totalNslip,:) - del%rho_sgl_mob_edg_pos => plasticState(p)%deltaState (0*prm%totalNslip+1: 1*prm%totalNslip,:) - - stt%rho_sgl_mob_edg_neg => plasticState(p)%state (1*prm%totalNslip+1: 2*prm%totalNslip,:) - dot%rho_sgl_mob_edg_neg => plasticState(p)%dotState (1*prm%totalNslip+1: 2*prm%totalNslip,:) - del%rho_sgl_mob_edg_neg => plasticState(p)%deltaState (1*prm%totalNslip+1: 2*prm%totalNslip,:) - - stt%rho_sgl_mob_scr_pos => plasticState(p)%state (2*prm%totalNslip+1: 3*prm%totalNslip,:) - dot%rho_sgl_mob_scr_pos => plasticState(p)%dotState (2*prm%totalNslip+1: 3*prm%totalNslip,:) - del%rho_sgl_mob_scr_pos => plasticState(p)%deltaState (2*prm%totalNslip+1: 3*prm%totalNslip,:) - - stt%rho_sgl_mob_scr_neg => plasticState(p)%state (3*prm%totalNslip+1: 4*prm%totalNslip,:) - dot%rho_sgl_mob_scr_neg => plasticState(p)%dotState (3*prm%totalNslip+1: 4*prm%totalNslip,:) - del%rho_sgl_mob_scr_neg => plasticState(p)%deltaState (3*prm%totalNslip+1: 4*prm%totalNslip,:) - - stt%rhoSglImmobile => plasticState(p)%state (4*prm%totalNslip+1: 8*prm%totalNslip,:) - dot%rhoSglImmobile => plasticState(p)%dotState (4*prm%totalNslip+1: 8*prm%totalNslip,:) - del%rhoSglImmobile => plasticState(p)%deltaState (4*prm%totalNslip+1: 8*prm%totalNslip,:) - - stt%rho_sgl_imm_edg_pos => plasticState(p)%state (4*prm%totalNslip+1: 5*prm%totalNslip,:) - dot%rho_sgl_imm_edg_pos => plasticState(p)%dotState (4*prm%totalNslip+1: 5*prm%totalNslip,:) - del%rho_sgl_imm_edg_pos => plasticState(p)%deltaState (4*prm%totalNslip+1: 5*prm%totalNslip,:) - - stt%rho_sgl_imm_edg_neg => plasticState(p)%state (5*prm%totalNslip+1: 6*prm%totalNslip,:) - dot%rho_sgl_imm_edg_neg => plasticState(p)%dotState (5*prm%totalNslip+1: 6*prm%totalNslip,:) - del%rho_sgl_imm_edg_neg => plasticState(p)%deltaState (5*prm%totalNslip+1: 6*prm%totalNslip,:) - - stt%rho_sgl_imm_scr_pos => plasticState(p)%state (6*prm%totalNslip+1: 7*prm%totalNslip,:) - dot%rho_sgl_imm_scr_pos => plasticState(p)%dotState(6*prm%totalNslip+1: 7*prm%totalNslip,:) - del%rho_sgl_imm_scr_pos => plasticState(p)%deltaState(6*prm%totalNslip+1: 7*prm%totalNslip,:) - - stt%rho_sgl_imm_scr_neg => plasticState(p)%state (7*prm%totalNslip+1: 8*prm%totalNslip,:) - dot%rho_sgl_imm_scr_neg => plasticState(p)%dotState(7*prm%totalNslip+1: 8*prm%totalNslip,:) - del%rho_sgl_imm_scr_neg => plasticState(p)%deltaState(7*prm%totalNslip+1: 8*prm%totalNslip,:) - - stt%rhoDip => plasticState(p)%state (8*prm%totalNslip+1:10*prm%totalNslip,:) - dot%rhoDip => plasticState(p)%dotState (8*prm%totalNslip+1:10*prm%totalNslip,:) - del%rhoDip => plasticState(p)%deltaState (8*prm%totalNslip+1:10*prm%totalNslip,:) - - stt%rho_dip_edg => plasticState(p)%state (8*prm%totalNslip+1: 9*prm%totalNslip,:) - dot%rho_dip_edg => plasticState(p)%dotState (8*prm%totalNslip+1: 9*prm%totalNslip,:) - del%rho_dip_edg => plasticState(p)%deltaState (8*prm%totalNslip+1: 9*prm%totalNslip,:) - - stt%rho_dip_scr => plasticState(p)%state (9*prm%totalNslip+1:10*prm%totalNslip,:) - dot%rho_dip_scr => plasticState(p)%dotState (9*prm%totalNslip+1:10*prm%totalNslip,:) - del%rho_dip_scr => plasticState(p)%deltaState (9*prm%totalNslip+1:10*prm%totalNslip,:) + stt%rho => plasticState(p)%state (0*prm%totalNslip+1:10*prm%totalNslip,:) + dot%rho => plasticState(p)%dotState (0*prm%totalNslip+1:10*prm%totalNslip,:) + del%rho => plasticState(p)%deltaState (0*prm%totalNslip+1:10*prm%totalNslip,:) + plasticState(p)%aTolState(1:10*prm%totalNslip) = prm%aTolRho + stt%rhoSgl => plasticState(p)%state (0*prm%totalNslip+1: 8*prm%totalNslip,:) + dot%rhoSgl => plasticState(p)%dotState (0*prm%totalNslip+1: 8*prm%totalNslip,:) + del%rhoSgl => plasticState(p)%deltaState (0*prm%totalNslip+1: 8*prm%totalNslip,:) + + stt%rhoSglMobile => plasticState(p)%state (0*prm%totalNslip+1: 4*prm%totalNslip,:) + dot%rhoSglMobile => plasticState(p)%dotState (0*prm%totalNslip+1: 4*prm%totalNslip,:) + del%rhoSglMobile => plasticState(p)%deltaState (0*prm%totalNslip+1: 4*prm%totalNslip,:) + + stt%rho_sgl_mob_edg_pos => plasticState(p)%state (0*prm%totalNslip+1: 1*prm%totalNslip,:) + dot%rho_sgl_mob_edg_pos => plasticState(p)%dotState (0*prm%totalNslip+1: 1*prm%totalNslip,:) + del%rho_sgl_mob_edg_pos => plasticState(p)%deltaState (0*prm%totalNslip+1: 1*prm%totalNslip,:) + + stt%rho_sgl_mob_edg_neg => plasticState(p)%state (1*prm%totalNslip+1: 2*prm%totalNslip,:) + dot%rho_sgl_mob_edg_neg => plasticState(p)%dotState (1*prm%totalNslip+1: 2*prm%totalNslip,:) + del%rho_sgl_mob_edg_neg => plasticState(p)%deltaState (1*prm%totalNslip+1: 2*prm%totalNslip,:) + + stt%rho_sgl_mob_scr_pos => plasticState(p)%state (2*prm%totalNslip+1: 3*prm%totalNslip,:) + dot%rho_sgl_mob_scr_pos => plasticState(p)%dotState (2*prm%totalNslip+1: 3*prm%totalNslip,:) + del%rho_sgl_mob_scr_pos => plasticState(p)%deltaState (2*prm%totalNslip+1: 3*prm%totalNslip,:) + + stt%rho_sgl_mob_scr_neg => plasticState(p)%state (3*prm%totalNslip+1: 4*prm%totalNslip,:) + dot%rho_sgl_mob_scr_neg => plasticState(p)%dotState (3*prm%totalNslip+1: 4*prm%totalNslip,:) + del%rho_sgl_mob_scr_neg => plasticState(p)%deltaState (3*prm%totalNslip+1: 4*prm%totalNslip,:) + + stt%rhoSglImmobile => plasticState(p)%state (4*prm%totalNslip+1: 8*prm%totalNslip,:) + dot%rhoSglImmobile => plasticState(p)%dotState (4*prm%totalNslip+1: 8*prm%totalNslip,:) + del%rhoSglImmobile => plasticState(p)%deltaState (4*prm%totalNslip+1: 8*prm%totalNslip,:) + + stt%rho_sgl_imm_edg_pos => plasticState(p)%state (4*prm%totalNslip+1: 5*prm%totalNslip,:) + dot%rho_sgl_imm_edg_pos => plasticState(p)%dotState (4*prm%totalNslip+1: 5*prm%totalNslip,:) + del%rho_sgl_imm_edg_pos => plasticState(p)%deltaState (4*prm%totalNslip+1: 5*prm%totalNslip,:) + + stt%rho_sgl_imm_edg_neg => plasticState(p)%state (5*prm%totalNslip+1: 6*prm%totalNslip,:) + dot%rho_sgl_imm_edg_neg => plasticState(p)%dotState (5*prm%totalNslip+1: 6*prm%totalNslip,:) + del%rho_sgl_imm_edg_neg => plasticState(p)%deltaState (5*prm%totalNslip+1: 6*prm%totalNslip,:) + + stt%rho_sgl_imm_scr_pos => plasticState(p)%state (6*prm%totalNslip+1: 7*prm%totalNslip,:) + dot%rho_sgl_imm_scr_pos => plasticState(p)%dotState(6*prm%totalNslip+1: 7*prm%totalNslip,:) + del%rho_sgl_imm_scr_pos => plasticState(p)%deltaState(6*prm%totalNslip+1: 7*prm%totalNslip,:) + + stt%rho_sgl_imm_scr_neg => plasticState(p)%state (7*prm%totalNslip+1: 8*prm%totalNslip,:) + dot%rho_sgl_imm_scr_neg => plasticState(p)%dotState(7*prm%totalNslip+1: 8*prm%totalNslip,:) + del%rho_sgl_imm_scr_neg => plasticState(p)%deltaState(7*prm%totalNslip+1: 8*prm%totalNslip,:) + + stt%rhoDip => plasticState(p)%state (8*prm%totalNslip+1:10*prm%totalNslip,:) + dot%rhoDip => plasticState(p)%dotState (8*prm%totalNslip+1:10*prm%totalNslip,:) + del%rhoDip => plasticState(p)%deltaState (8*prm%totalNslip+1:10*prm%totalNslip,:) + + stt%rho_dip_edg => plasticState(p)%state (8*prm%totalNslip+1: 9*prm%totalNslip,:) + dot%rho_dip_edg => plasticState(p)%dotState (8*prm%totalNslip+1: 9*prm%totalNslip,:) + del%rho_dip_edg => plasticState(p)%deltaState (8*prm%totalNslip+1: 9*prm%totalNslip,:) + + stt%rho_dip_scr => plasticState(p)%state (9*prm%totalNslip+1:10*prm%totalNslip,:) + dot%rho_dip_scr => plasticState(p)%dotState (9*prm%totalNslip+1:10*prm%totalNslip,:) + del%rho_dip_scr => plasticState(p)%deltaState (9*prm%totalNslip+1:10*prm%totalNslip,:) + stt%accumulatedshear => plasticState(p)%state (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) dot%accumulatedshear => plasticState(p)%dotState (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) del%accumulatedshear => plasticState(p)%deltaState (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) plasticState(p)%aTolState(10*prm%totalNslip + 1:11*prm%totalNslip ) = prm%aTolShear plasticState(p)%slipRate => plasticState(p)%dotState(10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) plasticState(p)%accumulatedSlip => plasticState(p)%state (10*prm%totalNslip + 1:11*prm%totalNslip ,1:NofMyPhase) - + stt%rho_forest => plasticState(p)%state (11*prm%totalNslip + 1:12*prm%totalNslip ,1:NofMyPhase) + stt%v => plasticState(p)%state (12*prm%totalNslip + 1:16*prm%totalNslip ,1:NofMyPhase) - - allocate(dst%tau_Threshold(prm%totalNslip,NofMyPhase),source=0.0_pReal) - allocate(dst%tau_Back(prm%totalNslip,NofMyPhase),source=0.0_pReal) - - allocate(res%rhoDotFlux(prm%totalNslip,8,NofMyPhase),source=0.0_pReal) - allocate(res%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) - allocate(res%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) - allocate(res%rhoDotAthermalAnnihilation(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) - allocate(res%rhoDotThermalAnnihilation(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) - allocate(res%rhoDotEdgeJogs(prm%totalNslip,NofMyPhase),source=0.0_pReal) - end associate + allocate(dst%tau_Threshold(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(dst%tau_Back(prm%totalNslip,NofMyPhase),source=0.0_pReal) + + allocate(res%rhoDotFlux(prm%totalNslip,8,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotAthermalAnnihilation(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotThermalAnnihilation(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotEdgeJogs(prm%totalNslip,NofMyPhase),source=0.0_pReal) + end associate - if (NofMyPhase > 0) call stateInit(p,NofMyPhase) - plasticState(p)%state0 = plasticState(p)%state + if (NofMyPhase > 0) call stateInit(p,NofMyPhase) + plasticState(p)%state0 = plasticState(p)%state enddo + allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & + source=0.0_pReal) + ! BEGIN DEPRECATED---------------------------------------------------------------------------------- allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0) allocate(iRhoB(maxval(totalNslip),4,maxNinstances), source=0) allocate(iRhoD(maxval(totalNslip),2,maxNinstances), source=0) allocate(iV(maxval(totalNslip),4,maxNinstances), source=0) allocate(iD(maxval(totalNslip),2,maxNinstances), source=0) + + initializeInstances: do p = 1, size(phase_plasticity) + NofMyPhase=count(material_phase==p) + myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then + + !*** determine indices to state array + + l = 0 + do t = 1,4 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 + iRhoU(s,t,phase_plasticityInstance(p)) = l + enddo + enddo + do t = 1,4 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 + iRhoB(s,t,phase_plasticityInstance(p)) = l + enddo + enddo + do c = 1,2 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 + iRhoD(s,c,phase_plasticityInstance(p)) = l + enddo + enddo + + l = l + param(phase_plasticityInstance(p))%totalNslip ! shear(rates) + l = l + param(phase_plasticityInstance(p))%totalNslip ! rho_forest + + do t = 1,4 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 + iV(s,t,phase_plasticityInstance(p)) = l + enddo + enddo + do c = 1,2 + do s = 1,param(phase_plasticityInstance(p))%totalNslip + l = l + 1 + iD(s,c,phase_plasticityInstance(p)) = l + enddo + enddo + if (iD(param(phase_plasticityInstance(p))%totalNslip,2,phase_plasticityInstance(p)) /= plasticState(p)%sizeState) & + call IO_error(0, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') + + + endif myPhase2 + + enddo initializeInstances ! END DEPRECATED------------------------------------------------------------------------------------ -allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) - - initializeInstances: do p = 1, size(phase_plasticity) - NofMyPhase=count(material_phase==p) - myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then - - !*** determine indices to state array - - l = 0 - do t = 1,4 - do s = 1,param(phase_plasticityInstance(p))%totalNslip - l = l + 1 - iRhoU(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - do t = 1,4 - do s = 1,param(phase_plasticityInstance(p))%totalNslip - l = l + 1 - iRhoB(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - do c = 1,2 - do s = 1,param(phase_plasticityInstance(p))%totalNslip - l = l + 1 - iRhoD(s,c,phase_plasticityInstance(p)) = l - enddo - enddo - - l = l + param(phase_plasticityInstance(p))%totalNslip ! shear(rates) - l = l + param(phase_plasticityInstance(p))%totalNslip ! rho_forest - - do t = 1,4 - do s = 1,param(phase_plasticityInstance(p))%totalNslip - l = l + 1 - iV(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - do c = 1,2 - do s = 1,param(phase_plasticityInstance(p))%totalNslip - l = l + 1 - iD(s,c,phase_plasticityInstance(p)) = l - enddo - enddo - if (iD(param(phase_plasticityInstance(p))%totalNslip,2,phase_plasticityInstance(p)) /= plasticState(p)%sizeState) & ! check if last index is equal to size of state - call IO_error(0, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') - - - endif myPhase2 - enddo initializeInstances - - - contains - -subroutine stateInit(phase,NofMyPhase) - use math, only: & - math_sampleGaussVar - use mesh, only: & - theMesh, & - mesh_ipVolume - use material, only: & - material_phase, & - phase_plasticityInstance, & - phasememberAt - implicit none - - integer,intent(in) ::& - phase, & - NofMyPhase - integer :: & - e, & - i, & - f, & - from, & - upto, & - s, & - instance, & - phasemember - real(pReal), dimension(2) :: & - noise, & - rnd - real(pReal) :: & - meanDensity, & - totalVolume, & - densityBinning, & - minimumIpVolume - real(pReal), dimension(NofMyPhase) :: & - volume - - - instance = phase_plasticityInstance(phase) - associate(prm => param(instance), stt => state(instance)) - - ! randomly distribute dislocation segments on random slip system and of random type in the volume - if (prm%rhoSglRandom > 0.0_pReal) then - - ! get the total volume of the instance - do e = 1,theMesh%nElems - do i = 1,theMesh%elem%nIPs - if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = mesh_ipVolume(i,e) - enddo - enddo - totalVolume = sum(volume) - minimumIPVolume = minval(volume) - densityBinning = prm%rhoSglRandomBinning / minimumIpVolume ** (2.0_pReal / 3.0_pReal) - - ! subsequently fill random ips with dislocation segments until we reach the desired overall density - meanDensity = 0.0_pReal - do while(meanDensity < prm%rhoSglRandom) - call random_number(rnd) - phasemember = nint(rnd(1)*real(NofMyPhase,pReal) + 0.5_pReal) - s = nint(rnd(2)*real(prm%totalNslip,pReal)*4.0_pReal + 0.5_pReal) - meanDensity = meanDensity + densityBinning * volume(phasemember) / totalVolume - stt%rhoSglMobile(s,phasemember) = densityBinning - enddo - ! homogeneous distribution of density with some noise - else - do e = 1, NofMyPhase - do f = 1,size(prm%Nslip,1) - from = 1 + sum(prm%Nslip(1:f-1)) - upto = sum(prm%Nslip(1:f)) - do s = from,upto - noise = [math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter), & - math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter)] - stt%rho_sgl_mob_edg_pos(s,e) = prm%rhoSglEdgePos0(f) + noise(1) - stt%rho_sgl_mob_edg_neg(s,e) = prm%rhoSglEdgeNeg0(f) + noise(1) - stt%rho_sgl_mob_scr_pos(s,e) = prm%rhoSglScrewPos0(f) + noise(2) - stt%rho_sgl_mob_scr_neg(s,e) = prm%rhoSglScrewNeg0(f) + noise(2) - enddo - stt%rho_dip_edg(from:upto,e) = prm%rhoDipEdge0(f) - stt%rho_dip_scr(from:upto,e) = prm%rhoDipScrew0(f) - enddo - enddo - endif + contains + !-------------------------------------------------------------------------------------------------- + !> @brief populates the initial dislocation density + !-------------------------------------------------------------------------------------------------- + subroutine stateInit(phase,NofMyPhase) + use math, only: & + math_sampleGaussVar + use mesh, only: & + theMesh, & + mesh_ipVolume + use material, only: & + material_phase, & + phase_plasticityInstance, & + phasememberAt + implicit none + + integer,intent(in) ::& + phase, & + NofMyPhase + integer :: & + e, & + i, & + f, & + from, & + upto, & + s, & + instance, & + phasemember + real(pReal), dimension(2) :: & + noise, & + rnd + real(pReal) :: & + meanDensity, & + totalVolume, & + densityBinning, & + minimumIpVolume + real(pReal), dimension(NofMyPhase) :: & + volume - end associate - -end subroutine stateInit + + instance = phase_plasticityInstance(phase) + associate(prm => param(instance), stt => state(instance)) + + ! randomly distribute dislocation segments on random slip system and of random type in the volume + if (prm%rhoSglRandom > 0.0_pReal) then + + ! get the total volume of the instance + do e = 1,theMesh%nElems + do i = 1,theMesh%elem%nIPs + if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = mesh_ipVolume(i,e) + enddo + enddo + totalVolume = sum(volume) + minimumIPVolume = minval(volume) + densityBinning = prm%rhoSglRandomBinning / minimumIpVolume ** (2.0_pReal / 3.0_pReal) + + ! subsequently fill random ips with dislocation segments until we reach the desired overall density + meanDensity = 0.0_pReal + do while(meanDensity < prm%rhoSglRandom) + call random_number(rnd) + phasemember = nint(rnd(1)*real(NofMyPhase,pReal) + 0.5_pReal) + s = nint(rnd(2)*real(prm%totalNslip,pReal)*4.0_pReal + 0.5_pReal) + meanDensity = meanDensity + densityBinning * volume(phasemember) / totalVolume + stt%rhoSglMobile(s,phasemember) = densityBinning + enddo + ! homogeneous distribution of density with some noise + else + do e = 1, NofMyPhase + do f = 1,size(prm%Nslip,1) + from = 1 + sum(prm%Nslip(1:f-1)) + upto = sum(prm%Nslip(1:f)) + do s = from,upto + noise = [math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter), & + math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter)] + stt%rho_sgl_mob_edg_pos(s,e) = prm%rhoSglEdgePos0(f) + noise(1) + stt%rho_sgl_mob_edg_neg(s,e) = prm%rhoSglEdgeNeg0(f) + noise(1) + stt%rho_sgl_mob_scr_pos(s,e) = prm%rhoSglScrewPos0(f) + noise(2) + stt%rho_sgl_mob_scr_neg(s,e) = prm%rhoSglScrewNeg0(f) + noise(2) + enddo + stt%rho_dip_edg(from:upto,e) = prm%rhoDipEdge0(f) + stt%rho_dip_scr(from:upto,e) = prm%rhoDipScrew0(f) + enddo + enddo + endif + + end associate + + end subroutine stateInit end subroutine plastic_nonlocal_init - !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) -use prec, only: & - dEq0 -use IO, only: & - IO_error -use math, only: & - pi, & - math_mul33x3, & - math_mul3x3, & - math_inv33 + use prec, only: & + dEq0 + use IO, only: & + IO_error + use math, only: & + PI, & + math_mul33x3, & + math_mul3x3, & + math_inv33 #ifdef DEBUG -use debug, only: & - debug_level, & - debug_constitutive, & - debug_levelExtensive, & - debug_levelSelective, & - debug_i, & - debug_e + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelExtensive, & + debug_levelSelective, & + debug_i, & + debug_e #endif -use mesh, only: & - theMesh, & - mesh_ipNeighborhood, & - mesh_ipCoordinates, & - mesh_ipVolume, & - mesh_ipAreaNormal, & - mesh_ipArea -use material, only: & - material_phase, & - phase_localPlasticity, & - phaseAt, phasememberAt, & - phase_plasticityInstance -use lattice, only: & - LATTICE_bcc_ID, & - LATTICE_fcc_ID, & - lattice_structure + use mesh, only: & + theMesh, & + mesh_ipNeighborhood, & + mesh_ipCoordinates, & + mesh_ipVolume, & + mesh_ipAreaNormal, & + mesh_ipArea + use material, only: & + material_phase, & + phase_localPlasticity, & + phaseAt, phasememberAt, & + phase_plasticityInstance + use lattice, only: & + LATTICE_bcc_ID, & + LATTICE_fcc_ID, & + lattice_structure + + implicit none + integer, intent(in) :: & + ip, & + el + real(pReal), dimension(3,3), intent(in) :: & + Fe, & + Fp + + integer :: & + ph, & !< phase + of, & !< offset + no, & !< neighbor offset + ns, & + neighbor_el, & ! element number of neighboring material point + neighbor_ip, & ! integration point of neighboring material point + instance, & ! my instance of this plasticity + neighbor_instance, & ! instance of this plasticity of neighboring material point + c, & ! index of dilsocation character (edge, screw) + s, & ! slip system index + dir, & + n + real(pReal) :: & + FVsize, & + correction, & + nRealNeighbors ! number of really existing neighbors + integer, dimension(2) :: & + neighbors + real(pReal), dimension(2) :: & + rhoExcessGradient, & + rhoExcessGradient_over_rho, & + rhoTotal + real(pReal), dimension(3) :: & + rhoExcessDifferences, & + normal_latticeConf + real(pReal), dimension(3,3) :: & + invFe, & !< inverse of elastic deformation gradient + invFp, & !< inverse of plastic deformation gradient + connections, & + invConnections + real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & + connection_latticeConf + real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + rhoExcess + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + rho_edg_delta, & + rho_scr_delta + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + rho, & + rho_neighbor + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))), & + totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + myInteractionMatrix ! corrected slip interaction matrix + + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),theMesh%elem%nIPneighbors) :: & + rho_edg_delta_neighbor, & + rho_scr_delta_neighbor + real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: & + neighbor_rhoExcess, & ! excess density at neighboring material point + neighbor_rhoTotal ! total density at neighboring material point + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + m ! direction of dislocation motion + + ph = phaseAt(1,ip,el) + of = phasememberAt(1,ip,el) + instance = phase_plasticityInstance(ph) -implicit none + associate(prm => param(instance),dst => microstructure(instance), stt => state(instance)) + + ns = prm%totalNslip + + rho = getRho(instance,of,ip,el) + + stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) + + + ! coefficients are corrected for the line tension effect + ! (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals) + if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc + do s = 1,ns + correction = ( 1.0_pReal - prm%linetensionEffect & + + prm%linetensionEffect & + * log(0.35_pReal * prm%burgers(s) * sqrt(max(stt%rho_forest(s,of),prm%significantRho))) & + / log(0.35_pReal * prm%burgers(s) * 1e6_pReal)) ** 2.0_pReal + myInteractionMatrix(1:ns,s) = correction * prm%interactionSlipSlip(1:ns,s) + enddo + else + myInteractionMatrix = prm%interactionSlipSlip + endif -integer, intent(in) :: ip, & ! current integration point - el ! current element -real(pReal), dimension(3,3), intent(in) :: & - Fe, & ! elastic deformation gradient - Fp ! elastic deformation gradient - - integer :: & - ph, & !< phase - of, & !< offset - no !< nieghbor offset - -integer ns, neighbor_el, & ! element number of neighboring material point - neighbor_ip, & ! integration point of neighboring material point - instance, & ! my instance of this plasticity - neighbor_instance, & ! instance of this plasticity of neighboring material point - c, & ! index of dilsocation character (edge, screw) - s, & ! slip system index - dir, & - n, & - nRealNeighbors ! number of really existing neighbors -integer, dimension(2) :: neighbors -real(pReal) FVsize, & - correction -real(pReal), dimension(2) :: rhoExcessGradient, & - rhoExcessGradient_over_rho, & - rhoTotal -real(pReal), dimension(3) :: rhoExcessDifferences, & - normal_latticeConf -real(pReal), dimension(3,3) :: invFe, & ! inverse of elastic deformation gradient - invFp, & ! inverse of plastic deformation gradient - connections, & - invConnections -real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & - connection_latticeConf -real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - rhoExcess -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - rho_edg_delta, & - rho_scr_delta -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & - rho, & - rho_neighbor -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))), & - totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - myInteractionMatrix ! corrected slip interaction matrix - -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),theMesh%elem%nIPneighbors) :: & - rho_edg_delta_neighbor, & - rho_scr_delta_neighbor, & - rho_edg_sum_neighbor, & - rho_scr_sum_neighbor -real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: & - neighbor_rhoExcess, & ! excess density at neighboring material point - neighbor_rhoTotal ! total density at neighboring material point -real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & - m ! direction of dislocation motion - -ph = phaseAt(1,ip,el) -of = phasememberAt(1,ip,el) -instance = phase_plasticityInstance(ph) -associate(prm => param(instance),dst => microstructure(instance), stt => state(instance)) - -ns = prm%totalNslip - -rho = getRho(instance,of,ip,el) - -stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & - + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) - - -!*** calculate the threshold shear stress for dislocation slip -!*** coefficients are corrected for the line tension effect -!*** (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals) - -if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc - do s = 1,ns - correction = ( 1.0_pReal - prm%linetensionEffect & - + prm%linetensionEffect & - * log(0.35_pReal * prm%burgers(s) * sqrt(max(stt%rho_forest(s,of),prm%significantRho))) & - / log(0.35_pReal * prm%burgers(s) * 1e6_pReal)) ** 2.0_pReal - myInteractionMatrix(1:ns,s) = correction * prm%interactionSlipSlip(1:ns,s) - enddo -else - myInteractionMatrix = prm%interactionSlipSlip -endif -forall (s = 1:ns) & - dst%tau_threshold(s,of) = prm%mu * prm%burgers(s) & + forall (s = 1:ns) & + dst%tau_threshold(s,of) = prm%mu * prm%burgers(s) & * sqrt(dot_product(sum(abs(rho),2), myInteractionMatrix(1:ns,s))) !*** calculate the dislocation stress of the neighboring excess dislocation densities !*** zero for material points of local plasticity - dst%tau_back(:,of) = 0.0_pReal - - !################################################################################################# !################################################################################################# ! ToDo: MD: this is most likely only correct for F_i = I !################################################################################################# - !################################################################################################# -if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then - invFe = math_inv33(Fe) - invFp = math_inv33(Fp) - - rho_edg_delta = rho(:,mob_edg_pos) - rho(:,mob_edg_neg) - rho_scr_delta = rho(:,mob_scr_pos) - rho(:,mob_scr_neg) - - rhoExcess(1,1:ns) = rho_edg_delta - rhoExcess(2,1:ns) = rho_scr_delta - - FVsize = mesh_ipVolume(ip,el) ** (1.0_pReal/3.0_pReal) + if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then + invFe = math_inv33(Fe) + invFp = math_inv33(Fp) - !* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities + rho_edg_delta = rho(:,mob_edg_pos) - rho(:,mob_edg_neg) + rho_scr_delta = rho(:,mob_scr_pos) - rho(:,mob_scr_neg) - nRealNeighbors = 0 - neighbor_rhoTotal = 0.0_pReal - do n = 1,theMesh%elem%nIPneighbors - neighbor_el = mesh_ipNeighborhood(1,n,ip,el) - neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) - no = phasememberAt(1,neighbor_ip,neighbor_el) - if (neighbor_el > 0 .and. neighbor_ip > 0) then - neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) - if (neighbor_instance == instance) then - - nRealNeighbors = nRealNeighbors + 1 - rho_neighbor = getRho(instance,no,neighbor_ip,neighbor_el) - - rho_edg_delta_neighbor(:,n) = rho_neighbor(:,mob_edg_pos) - rho_neighbor(:,mob_edg_neg) - rho_scr_delta_neighbor(:,n) = rho_neighbor(:,mob_scr_pos) - rho_neighbor(:,mob_scr_neg) - - neighbor_rhoTotal(1,:,n) = sum(abs(rho_neighbor(:,edg)),2) - neighbor_rhoTotal(2,:,n) = sum(abs(rho_neighbor(:,scr)),2) - - connection_latticeConf(1:3,n) = & - math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & - - mesh_ipCoordinates(1:3,ip,el)) - normal_latticeConf = math_mul33x3(transpose(invFp), mesh_ipAreaNormal(1:3,n,ip,el)) - if (math_mul3x3(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) & ! neighboring connection points in opposite direction to face normal: must be periodic image - connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el) & - / mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell + rhoExcess(1,1:ns) = rho_edg_delta + rhoExcess(2,1:ns) = rho_scr_delta + + FVsize = mesh_ipVolume(ip,el) ** (1.0_pReal/3.0_pReal) + + !* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities + + nRealNeighbors = 0.0_pReal + neighbor_rhoTotal = 0.0_pReal + do n = 1,theMesh%elem%nIPneighbors + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) + neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) + no = phasememberAt(1,neighbor_ip,neighbor_el) + if (neighbor_el > 0 .and. neighbor_ip > 0) then + neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) + if (neighbor_instance == instance) then + + nRealNeighbors = nRealNeighbors + 1.0_pReal + rho_neighbor = getRho(instance,no,neighbor_ip,neighbor_el) + + rho_edg_delta_neighbor(:,n) = rho_neighbor(:,mob_edg_pos) - rho_neighbor(:,mob_edg_neg) + rho_scr_delta_neighbor(:,n) = rho_neighbor(:,mob_scr_pos) - rho_neighbor(:,mob_scr_neg) + + neighbor_rhoTotal(1,:,n) = sum(abs(rho_neighbor(:,edg)),2) + neighbor_rhoTotal(2,:,n) = sum(abs(rho_neighbor(:,scr)),2) + + connection_latticeConf(1:3,n) = & + math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & + - mesh_ipCoordinates(1:3,ip,el)) + normal_latticeConf = math_mul33x3(transpose(invFp), mesh_ipAreaNormal(1:3,n,ip,el)) + if (math_mul3x3(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) & ! neighboring connection points in opposite direction to face normal: must be periodic image + connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el)/mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell + else + ! local neighbor or different lattice structure or different constitution instance -> use central values instead + connection_latticeConf(1:3,n) = 0.0_pReal + rho_edg_delta_neighbor(:,n) = rho_edg_delta + rho_scr_delta_neighbor(:,n) = rho_scr_delta + endif else - ! local neighbor or different lattice structure or different constitution instance -> use central values instead + ! free surface -> use central values instead connection_latticeConf(1:3,n) = 0.0_pReal rho_edg_delta_neighbor(:,n) = rho_edg_delta rho_scr_delta_neighbor(:,n) = rho_scr_delta endif - else - ! free surface -> use central values instead - connection_latticeConf(1:3,n) = 0.0_pReal - rho_edg_delta_neighbor(:,n) = rho_edg_delta - rho_scr_delta_neighbor(:,n) = rho_scr_delta - endif - enddo - - neighbor_rhoExcess(1,:,:) = rho_edg_delta_neighbor - neighbor_rhoExcess(2,:,:) = rho_scr_delta_neighbor - - !* loop through the slip systems and calculate the dislocation gradient by - !* 1. interpolation of the excess density in the neighorhood - !* 2. interpolation of the dead dislocation density in the central volume - - m(1:3,1:ns,1) = prm%slip_direction - m(1:3,1:ns,2) = -prm%slip_transverse - - do s = 1,ns - - ! gradient from interpolation of neighboring excess density ... - do c = 1,2 - do dir = 1,3 - neighbors(1) = 2 * dir - 1 - neighbors(2) = 2 * dir - connections(dir,1:3) = connection_latticeConf(1:3,neighbors(1)) & - - connection_latticeConf(1:3,neighbors(2)) - rhoExcessDifferences(dir) = neighbor_rhoExcess(c,s,neighbors(1)) & - - neighbor_rhoExcess(c,s,neighbors(2)) - enddo - invConnections = math_inv33(connections) - if (all(dEq0(invConnections))) call IO_error(-1,ext_msg='back stress calculation: inversion error') - - rhoExcessGradient(c) = math_mul3x3(m(1:3,s,c), math_mul33x3(invConnections,rhoExcessDifferences)) enddo - - ! ... plus gradient from deads ... - rhoExcessGradient(1) = rhoExcessGradient(1) + sum(rho(s,imm_edg)) / FVsize - rhoExcessGradient(2) = rhoExcessGradient(2) + sum(rho(s,imm_scr)) / FVsize - - ! ... normalized with the total density ... - rhoTotal(1) = (sum(abs(rho(s,edg))) + sum(neighbor_rhoTotal(1,s,:))) / real(1 + nRealNeighbors,pReal) - rhoTotal(2) = (sum(abs(rho(s,scr))) + sum(neighbor_rhoTotal(2,s,:))) / real(1 + nRealNeighbors,pReal) - - rhoExcessGradient_over_rho = 0.0_pReal - where(rhoTotal > 0.0_pReal) & - rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal - ! ... gives the local stress correction when multiplied with a factor - dst%tau_back(s,of) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & - * (rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) + rhoExcessGradient_over_rho(2)) - - enddo -endif + neighbor_rhoExcess(1,:,:) = rho_edg_delta_neighbor + neighbor_rhoExcess(2,:,:) = rho_scr_delta_neighbor + + !* loop through the slip systems and calculate the dislocation gradient by + !* 1. interpolation of the excess density in the neighorhood + !* 2. interpolation of the dead dislocation density in the central volume + m(1:3,1:ns,1) = prm%slip_direction + m(1:3,1:ns,2) = -prm%slip_transverse + + do s = 1,ns + + ! gradient from interpolation of neighboring excess density ... + do c = 1,2 + do dir = 1,3 + neighbors(1) = 2 * dir - 1 + neighbors(2) = 2 * dir + connections(dir,1:3) = connection_latticeConf(1:3,neighbors(1)) & + - connection_latticeConf(1:3,neighbors(2)) + rhoExcessDifferences(dir) = neighbor_rhoExcess(c,s,neighbors(1)) & + - neighbor_rhoExcess(c,s,neighbors(2)) + enddo + invConnections = math_inv33(connections) + if (all(dEq0(invConnections))) call IO_error(-1,ext_msg='back stress calculation: inversion error') + + rhoExcessGradient(c) = math_mul3x3(m(1:3,s,c), math_mul33x3(invConnections,rhoExcessDifferences)) + enddo + + ! ... plus gradient from deads ... + rhoExcessGradient(1) = rhoExcessGradient(1) + sum(rho(s,imm_edg)) / FVsize + rhoExcessGradient(2) = rhoExcessGradient(2) + sum(rho(s,imm_scr)) / FVsize + + ! ... normalized with the total density ... + rhoTotal(1) = (sum(abs(rho(s,edg))) + sum(neighbor_rhoTotal(1,s,:))) / (1.0_pReal + nRealNeighbors) + rhoTotal(2) = (sum(abs(rho(s,scr))) + sum(neighbor_rhoTotal(2,s,:))) / (1.0_pReal + nRealNeighbors) + + rhoExcessGradient_over_rho = 0.0_pReal + where(rhoTotal > 0.0_pReal) & + rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal + + ! ... gives the local stress correction when multiplied with a factor + dst%tau_back(s,of) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & + * (rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) + rhoExcessGradient_over_rho(2)) + + enddo + endif #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & @@ -1109,276 +1090,280 @@ end subroutine plastic_nonlocal_dependentState !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & tauThreshold, c, Temperature, instance, of) - -implicit none -integer, intent(in) :: c, & !< dislocation character (1:edge, 2:screw) - instance, of -real(pReal), intent(in) :: Temperature !< temperature -real(pReal), dimension(param(instance)%totalNslip), & - intent(in) :: tau, & !< resolved external shear stress (without non Schmid effects) - tauNS, & !< resolved external shear stress (including non Schmid effects) - tauThreshold !< threshold shear stress - -real(pReal), dimension(param(instance)%totalNslip), & - intent(out) :: v, & !< velocity - dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) - dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) - -integer :: ns, & !< short notation for the total number of active slip systems - s !< index of my current slip system -real(pReal) tauRel_P, & - tauRel_S, & - tauEff, & !< effective shear stress - tPeierls, & !< waiting time in front of a peierls barriers - tSolidSolution, & !< waiting time in front of a solid solution obstacle - vViscous, & !< viscous glide velocity - dtPeierls_dtau, & !< derivative with respect to resolved shear stress - dtSolidSolution_dtau, & !< derivative with respect to resolved shear stress - meanfreepath_S, & !< mean free travel distance for dislocations between two solid solution obstacles - meanfreepath_P, & !< mean free travel distance for dislocations between two Peierls barriers - jumpWidth_P, & !< depth of activated area - jumpWidth_S, & !< depth of activated area - activationLength_P, & !< length of activated dislocation line - activationLength_S, & !< length of activated dislocation line - activationVolume_P, & !< volume that needs to be activated to overcome barrier - activationVolume_S, & !< volume that needs to be activated to overcome barrier - activationEnergy_P, & !< energy that is needed to overcome barrier - activationEnergy_S, & !< energy that is needed to overcome barrier - criticalStress_P, & !< maximum obstacle strength - criticalStress_S, & !< maximum obstacle strength - mobility !< dislocation mobility - -associate(prm => param(instance)) -ns = prm%totalNslip -v = 0.0_pReal -dv_dtau = 0.0_pReal -dv_dtauNS = 0.0_pReal - - -if (Temperature > 0.0_pReal) then - do s = 1,ns - if (abs(tau(s)) > tauThreshold(s)) then - - !* Peierls contribution - !* Effective stress includes non Schmid constributions - !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity - - tauEff = max(0.0_pReal, abs(tauNS(s)) - tauThreshold(s)) ! ensure that the effective stress is positive - meanfreepath_P = prm%burgers(s) - jumpWidth_P = prm%burgers(s) - activationLength_P = prm%doublekinkwidth *prm%burgers(s) - activationVolume_P = activationLength_P * jumpWidth_P * prm%burgers(s) - criticalStress_P = prm%peierlsStress(s,c) - activationEnergy_P = criticalStress_P * activationVolume_P - tauRel_P = min(1.0_pReal, tauEff / criticalStress_P) ! ensure that the activation probability cannot become greater than one - tPeierls = 1.0_pReal / prm%fattack & - * exp(activationEnergy_P / (KB * Temperature) & - * (1.0_pReal - tauRel_P**prm%p)**prm%q) - if (tauEff < criticalStress_P) then - dtPeierls_dtau = tPeierls * prm%p * prm%q * activationVolume_P / (KB * Temperature) & - * (1.0_pReal - tauRel_P**prm%p)**(prm%q-1.0_pReal) & - * tauRel_P**(prm%p-1.0_pReal) - else - dtPeierls_dtau = 0.0_pReal + implicit none + integer, intent(in) :: & + c, & !< dislocation character (1:edge, 2:screw) + instance, of + real(pReal), intent(in) :: & + Temperature !< temperature + real(pReal), dimension(param(instance)%totalNslip), intent(in) :: & + tau, & !< resolved external shear stress (without non Schmid effects) + tauNS, & !< resolved external shear stress (including non Schmid effects) + tauThreshold !< threshold shear stress + + real(pReal), dimension(param(instance)%totalNslip), intent(out) :: & + v, & !< velocity + dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) + dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) + + integer :: & + ns, & !< short notation for the total number of active slip systems + s !< index of my current slip system + real(pReal) :: & + tauRel_P, & + tauRel_S, & + tauEff, & !< effective shear stress + tPeierls, & !< waiting time in front of a peierls barriers + tSolidSolution, & !< waiting time in front of a solid solution obstacle + vViscous, & !< viscous glide velocity + dtPeierls_dtau, & !< derivative with respect to resolved shear stress + dtSolidSolution_dtau, & !< derivative with respect to resolved shear stress + meanfreepath_S, & !< mean free travel distance for dislocations between two solid solution obstacles + meanfreepath_P, & !< mean free travel distance for dislocations between two Peierls barriers + jumpWidth_P, & !< depth of activated area + jumpWidth_S, & !< depth of activated area + activationLength_P, & !< length of activated dislocation line + activationLength_S, & !< length of activated dislocation line + activationVolume_P, & !< volume that needs to be activated to overcome barrier + activationVolume_S, & !< volume that needs to be activated to overcome barrier + activationEnergy_P, & !< energy that is needed to overcome barrier + activationEnergy_S, & !< energy that is needed to overcome barrier + criticalStress_P, & !< maximum obstacle strength + criticalStress_S, & !< maximum obstacle strength + mobility !< dislocation mobility + + associate(prm => param(instance)) + ns = prm%totalNslip + v = 0.0_pReal + dv_dtau = 0.0_pReal + dv_dtauNS = 0.0_pReal + + + if (Temperature > 0.0_pReal) then + do s = 1,ns + if (abs(tau(s)) > tauThreshold(s)) then + + !* Peierls contribution + !* Effective stress includes non Schmid constributions + !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity + + tauEff = max(0.0_pReal, abs(tauNS(s)) - tauThreshold(s)) ! ensure that the effective stress is positive + meanfreepath_P = prm%burgers(s) + jumpWidth_P = prm%burgers(s) + activationLength_P = prm%doublekinkwidth *prm%burgers(s) + activationVolume_P = activationLength_P * jumpWidth_P * prm%burgers(s) + criticalStress_P = prm%peierlsStress(s,c) + activationEnergy_P = criticalStress_P * activationVolume_P + tauRel_P = min(1.0_pReal, tauEff / criticalStress_P) ! ensure that the activation probability cannot become greater than one + tPeierls = 1.0_pReal / prm%fattack & + * exp(activationEnergy_P / (KB * Temperature) & + * (1.0_pReal - tauRel_P**prm%p)**prm%q) + if (tauEff < criticalStress_P) then + dtPeierls_dtau = tPeierls * prm%p * prm%q * activationVolume_P / (KB * Temperature) & + * (1.0_pReal - tauRel_P**prm%p)**(prm%q-1.0_pReal) & + * tauRel_P**(prm%p-1.0_pReal) + else + dtPeierls_dtau = 0.0_pReal + endif + + + !* Contribution from solid solution strengthening + !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity + + tauEff = abs(tau(s)) - tauThreshold(s) + meanfreepath_S = prm%burgers(s) / sqrt(prm%solidSolutionConcentration) + jumpWidth_S = prm%solidSolutionSize * prm%burgers(s) + activationLength_S = prm%burgers(s) / sqrt(prm%solidSolutionConcentration) + activationVolume_S = activationLength_S * jumpWidth_S * prm%burgers(s) + activationEnergy_S = prm%solidSolutionEnergy + criticalStress_S = activationEnergy_S / activationVolume_S + tauRel_S = min(1.0_pReal, tauEff / criticalStress_S) ! ensure that the activation probability cannot become greater than one + tSolidSolution = 1.0_pReal / prm%fattack & + * exp(activationEnergy_S / (KB * Temperature) & + * (1.0_pReal - tauRel_S**prm%p)**prm%q) + if (tauEff < criticalStress_S) then + dtSolidSolution_dtau = tSolidSolution * prm%p * prm%q & + * activationVolume_S / (KB * Temperature) & + * (1.0_pReal - tauRel_S**prm%p)**(prm%q-1.0_pReal) & + * tauRel_S**(prm%p-1.0_pReal) + else + dtSolidSolution_dtau = 0.0_pReal + endif + + + !* viscous glide velocity + + tauEff = abs(tau(s)) - tauThreshold(s) + mobility = prm%burgers(s) / prm%viscosity + vViscous = mobility * tauEff + + + !* Mean velocity results from waiting time at peierls barriers and solid solution obstacles with respective meanfreepath of + !* free flight at glide velocity in between. + !* adopt sign from resolved stress + + v(s) = sign(1.0_pReal,tau(s)) & + / (tPeierls / meanfreepath_P + tSolidSolution / meanfreepath_S + 1.0_pReal / vViscous) + dv_dtau(s) = v(s) * v(s) * (dtSolidSolution_dtau / meanfreepath_S & + + mobility / (vViscous * vViscous)) + dv_dtauNS(s) = v(s) * v(s) * dtPeierls_dtau / meanfreepath_P endif - - - !* Contribution from solid solution strengthening - !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity - - tauEff = abs(tau(s)) - tauThreshold(s) - meanfreepath_S = prm%burgers(s) / sqrt(prm%solidSolutionConcentration) - jumpWidth_S = prm%solidSolutionSize * prm%burgers(s) - activationLength_S = prm%burgers(s) / sqrt(prm%solidSolutionConcentration) - activationVolume_S = activationLength_S * jumpWidth_S * prm%burgers(s) - activationEnergy_S = prm%solidSolutionEnergy - criticalStress_S = activationEnergy_S / activationVolume_S - tauRel_S = min(1.0_pReal, tauEff / criticalStress_S) ! ensure that the activation probability cannot become greater than one - tSolidSolution = 1.0_pReal / prm%fattack & - * exp(activationEnergy_S / (KB * Temperature) & - * (1.0_pReal - tauRel_S**prm%p)**prm%q) - if (tauEff < criticalStress_S) then - dtSolidSolution_dtau = tSolidSolution * prm%p * prm%q & - * activationVolume_S / (KB * Temperature) & - * (1.0_pReal - tauRel_S**prm%p)**(prm%q-1.0_pReal) & - * tauRel_S**(prm%p-1.0_pReal) - else - dtSolidSolution_dtau = 0.0_pReal - endif - - - !* viscous glide velocity - - tauEff = abs(tau(s)) - tauThreshold(s) - mobility = prm%burgers(s) / prm%viscosity - vViscous = mobility * tauEff - - - !* Mean velocity results from waiting time at peierls barriers and solid solution obstacles with respective meanfreepath of - !* free flight at glide velocity in between. - !* adopt sign from resolved stress - - v(s) = sign(1.0_pReal,tau(s)) & - / (tPeierls / meanfreepath_P + tSolidSolution / meanfreepath_S + 1.0_pReal / vViscous) - dv_dtau(s) = v(s) * v(s) * (dtSolidSolution_dtau / meanfreepath_S & - + mobility / (vViscous * vViscous)) - dv_dtauNS(s) = v(s) * v(s) * dtPeierls_dtau / meanfreepath_P - endif - enddo -endif + enddo + endif #ifdef DEBUGTODO - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold * 1e-6_pReal - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tau / MPa', tau * 1e-6_pReal - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauNS / MPa', tauNS * 1e-6_pReal - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> v / mm/s', v * 1e3 - write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtau', dv_dtau - write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtauNS', dv_dtauNS - endif + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold * 1e-6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tau / MPa', tau * 1e-6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauNS / MPa', tauNS * 1e-6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> v / mm/s', v * 1e3 + write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtau', dv_dtau + write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtauNS', dv_dtauNS #endif -end associate + end associate + end subroutine plastic_nonlocal_kinetics + !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & Mp, Temperature, volume, ip, el) - use math, only: & math_mul33xx33 use material, only: & material_phase, & - plasticState, & - phaseAt, phasememberAt,& - phase_plasticityInstance + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance -implicit none -integer, intent(in) :: ip, & !< current integration point - el !< current element number -real(pReal), intent(in) :: Temperature, & !< temperature -volume !< volume of the materialpoint -real(pReal), dimension(3,3), intent(in) :: Mp - - -real(pReal), dimension(3,3), intent(out) :: Lp !< plastic velocity gradient -real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp !< derivative of Lp with respect to Tstar (9x9 matrix) - - -integer instance, & !< current instance of this plasticity - ns, & !< short notation for the total number of active slip systems - i, & - j, & - k, & - l, & - ph, & !phase number - of, & !offset - t, & !< dislocation type - s !< index of my current slip system -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & - rhoSgl !< single dislocation densities (including blocked) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & - rho -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & - v, & !< velocity - tauNS, & !< resolved shear stress including non Schmid and backstress terms - dv_dtau, & !< velocity derivative with respect to the shear stress - dv_dtauNS !< velocity derivative with respect to the shear stress -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - tau, & !< resolved shear stress including backstress terms - gdotTotal !< shear rate - -!*** shortcut for mapping -ph = phaseAt(1,ip,el) -of = phasememberAt(1,ip,el) - -instance = phase_plasticityInstance(ph) -associate(prm => param(instance),dst=>microstructure(instance)) -ns = prm%totalNslip - -!*** shortcut to state variables -rho = getRho(instance,of,ip,el) -rhoSgl = rho(:,sgl) - - -!*** get resolved shear stress -!*** for screws possible non-schmid contributions are also taken into account -do s = 1,ns - tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) - tauNS(s,1) = tau(s) - tauNS(s,2) = tau(s) - if (tau(s) > 0.0_pReal) then - tauNS(s,3) = math_mul33xx33(Mp, +prm%nonSchmid_pos(1:3,1:3,s)) - tauNS(s,4) = math_mul33xx33(Mp, -prm%nonSchmid_neg(1:3,1:3,s)) - else - tauNS(s,3) = math_mul33xx33(Mp, +prm%nonSchmid_neg(1:3,1:3,s)) - tauNS(s,4) = math_mul33xx33(Mp, -prm%nonSchmid_pos(1:3,1:3,s)) - endif -enddo -forall (t = 1:4) & - tauNS(1:ns,t) = tauNS(1:ns,t) + dst%tau_back(:,of) -tau = tau + dst%tau_back(:,of) - - -!*** get dislocation velocity and its tangent and store the velocity in the state array - -! edges -call plastic_nonlocal_kinetics(v(1:ns,1), dv_dtau(1:ns,1), dv_dtauNS(1:ns,1), & - tau(1:ns), tauNS(1:ns,1), dst%tau_Threshold(1:ns,of), & - 1, Temperature, instance, of) -v(1:ns,2) = v(1:ns,1) -dv_dtau(1:ns,2) = dv_dtau(1:ns,1) -dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) - -!screws -if (size(prm%nonSchmidCoeff) == 0) then ! no non-Schmid contributions - forall(t = 3:4) - v(1:ns,t) = v(1:ns,1) - dv_dtau(1:ns,t) = dv_dtau(1:ns,1) - dv_dtauNS(1:ns,t) = dv_dtauNS(1:ns,1) - endforall -else ! take non-Schmid contributions into account - do t = 3,4 - call plastic_nonlocal_kinetics(v(1:ns,t), dv_dtau(1:ns,t), dv_dtauNS(1:ns,t), & - tau(1:ns), tauNS(1:ns,t), dst%tau_Threshold(1:ns,of), & - 2 , Temperature, instance, of) + implicit none + integer, intent(in) :: & + ip, & !< current integration point + el !< current element number + real(pReal), intent(in) :: & + Temperature, & !< temperature + volume !< volume of the materialpoint + real(pReal), dimension(3,3), intent(in) :: & + Mp + real(pReal), dimension(3,3), intent(out) :: & + Lp !< plastic velocity gradient + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp !< derivative of Lp with respect to Tstar (9x9 matrix) + + + integer :: & + instance, & !< current instance of this plasticity + ns, & !< short notation for the total number of active slip systems + i, & + j, & + k, & + l, & + ph, & !phase number + of, & !offset + t, & !< dislocation type + s !< index of my current slip system + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & + rhoSgl !< single dislocation densities (including blocked) + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + rho + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + v, & !< velocity + tauNS, & !< resolved shear stress including non Schmid and backstress terms + dv_dtau, & !< velocity derivative with respect to the shear stress + dv_dtauNS !< velocity derivative with respect to the shear stress + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + tau, & !< resolved shear stress including backstress terms + gdotTotal !< shear rate + + !*** shortcut for mapping + ph = phaseAt(1,ip,el) + of = phasememberAt(1,ip,el) + + instance = phase_plasticityInstance(ph) + associate(prm => param(instance),dst=>microstructure(instance)) + ns = prm%totalNslip + + !*** shortcut to state variables + rho = getRho(instance,of,ip,el) + rhoSgl = rho(:,sgl) + + + !*** get resolved shear stress + !*** for screws possible non-schmid contributions are also taken into account + do s = 1,ns + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauNS(s,1) = tau(s) + tauNS(s,2) = tau(s) + if (tau(s) > 0.0_pReal) then + tauNS(s,3) = math_mul33xx33(Mp, +prm%nonSchmid_pos(1:3,1:3,s)) + tauNS(s,4) = math_mul33xx33(Mp, -prm%nonSchmid_neg(1:3,1:3,s)) + else + tauNS(s,3) = math_mul33xx33(Mp, +prm%nonSchmid_neg(1:3,1:3,s)) + tauNS(s,4) = math_mul33xx33(Mp, -prm%nonSchmid_pos(1:3,1:3,s)) + endif enddo -endif - - -!*** store velocity in state - -forall (t = 1:4) & - plasticState(ph)%state(iV(1:ns,t,instance),of) = v(1:ns,t) -!*** Bauschinger effect - -forall (s = 1:ns, t = 5:8, rhoSgl(s,t) * v(s,t-4) < 0.0_pReal) & - rhoSgl(s,t-4) = rhoSgl(s,t-4) + abs(rhoSgl(s,t)) - - -!*** Calculation of Lp and its tangent - -gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * prm%burgers(1:ns) - -Lp = 0.0_pReal -dLp_dMp = 0.0_pReal - -do s = 1,ns - Lp = Lp + gdotTotal(s) * prm%Schmid(1:3,1:3,s) - forall (i=1:3,j=1:3,k=1:3,l=1:3) & - dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & - + prm%Schmid(i,j,s) * prm%Schmid(k,l,s) & - * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * prm%burgers(s) & - + prm%Schmid(i,j,s) & - * ( prm%nonSchmid_pos(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) & - - prm%nonSchmid_neg(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4)) * prm%burgers(s) -enddo - - -end associate - + forall (t = 1:4) & + tauNS(1:ns,t) = tauNS(1:ns,t) + dst%tau_back(:,of) + tau = tau + dst%tau_back(:,of) + + + !*** get dislocation velocity and its tangent and store the velocity in the state array + + ! edges + call plastic_nonlocal_kinetics(v(1:ns,1), dv_dtau(1:ns,1), dv_dtauNS(1:ns,1), & + tau(1:ns), tauNS(1:ns,1), dst%tau_Threshold(1:ns,of), & + 1, Temperature, instance, of) + v(1:ns,2) = v(1:ns,1) + dv_dtau(1:ns,2) = dv_dtau(1:ns,1) + dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) + + !screws + if (size(prm%nonSchmidCoeff) == 0) then + forall(t = 3:4) + v(1:ns,t) = v(1:ns,1) + dv_dtau(1:ns,t) = dv_dtau(1:ns,1) + dv_dtauNS(1:ns,t) = dv_dtauNS(1:ns,1) + endforall + else + do t = 3,4 + call plastic_nonlocal_kinetics(v(1:ns,t), dv_dtau(1:ns,t), dv_dtauNS(1:ns,t), & + tau(1:ns), tauNS(1:ns,t), dst%tau_Threshold(1:ns,of), & + 2 , Temperature, instance, of) + enddo + endif + + + !*** store velocity in state + forall (t = 1:4) & + plasticState(ph)%state(iV(1:ns,t,instance),of) = v(1:ns,t) + + !*** Bauschinger effect + forall (s = 1:ns, t = 5:8, rhoSgl(s,t) * v(s,t-4) < 0.0_pReal) & + rhoSgl(s,t-4) = rhoSgl(s,t-4) + abs(rhoSgl(s,t)) + + + gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * prm%burgers(1:ns) + + Lp = 0.0_pReal + dLp_dMp = 0.0_pReal + + do s = 1,ns + Lp = Lp + gdotTotal(s) * prm%Schmid(1:3,1:3,s) + forall (i=1:3,j=1:3,k=1:3,l=1:3) & + dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & + + prm%Schmid(i,j,s) * prm%Schmid(k,l,s) & + * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * prm%burgers(s) & + + prm%Schmid(i,j,s) & + * ( prm%nonSchmid_pos(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) & + - prm%nonSchmid_neg(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4)) * prm%burgers(s) + enddo + + + end associate + end subroutine plastic_nonlocal_LpAndItsTangent @@ -1386,131 +1371,126 @@ end subroutine plastic_nonlocal_LpAndItsTangent !> @brief (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_deltaState(Mp,ip,el) -use prec, only: & - dNeq0 + use prec, only: & + dNeq0 #ifdef DEBUG -use debug, only: debug_level, & - debug_constitutive, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective, & - debug_i, & - debug_e + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelBasic, & + debug_levelExtensive, & + debug_levelSelective, & + debug_i, & + debug_e #endif -use math, only: PI, & - math_mul33xx33 -use mesh, only: mesh_ipVolume -use material, only: material_phase, & - plasticState, & - phaseAt, phasememberAt, & - phase_plasticityInstance + use math, only: & + PI, & + math_mul33xx33 + use material, only: & + material_phase, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + + implicit none + integer, intent(in) :: & + ip, & + el + real(pReal), dimension(3,3), intent(in) :: & + Mp !< MandelStress -implicit none -integer, intent(in) :: ip, & ! current grain number - el ! current element number -real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress - - - integer :: & - ph, & !< phase - of !< offset - -integer ::instance, & ! current instance of this plasticity - ns, & ! short notation for the total number of active slip systems - c, & ! character of dislocation - t, & ! type of dislocation - s ! index of my current slip system -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & - deltaRho, & ! density increment - deltaRhoRemobilization, & ! density increment by remobilization - deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & - rho ! current dislocation densities -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & - v ! dislocation glide velocity -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - tau ! current resolved shear stress -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & - rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) - dLower, & ! minimum stable dipole distance for edges and screws - dUpper, & ! current maximum stable dipole distance for edges and screws - dUpperOld, & ! old maximum stable dipole distance for edges and screws - deltaDUpper ! change in maximum stable dipole distance for edges and screws - - ph = phaseAt(1,ip,el) - of = phasememberAt(1,ip,el) - instance = phase_plasticityInstance(ph) - associate(prm => param(instance),dst => microstructure(instance),del => deltaState(instance)) - ns = totalNslip(instance) - -!*** shortcut to state variables - forall (s = 1:ns, t = 1:4) - v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) -endforall -forall (s = 1:ns, c = 1:2) - dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) -endforall - - rho = getRho(instance,of,ip,el) - rhoDip = rho(:,dip) - -!**************************************************************************** -!*** dislocation remobilization (bauschinger effect) -where(rho(:,imm) * v < 0.0_pReal) - deltaRhoRemobilization(:,mob) = abs(rho(:,imm)) - deltaRhoRemobilization(:,imm) = - rho(:,imm) - rho(:,mob) = rho(:,mob) + abs(rho(:,imm)) - rho(:,imm) = 0.0_pReal -elsewhere - deltaRhoRemobilization(:,mob) = 0.0_pReal - deltaRhoRemobilization(:,imm) = 0.0_pReal -endwhere -deltaRhoRemobilization(:,dip) = 0.0_pReal - -!**************************************************************************** -!*** calculate dipole formation and dissociation by stress change - -!*** calculate limits for stable dipole height - -do s = 1,prm%totalNslip - tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,of) - if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal -enddo -dLower = prm%minDipoleHeight - -dUpper(1:ns,1) = prm%mu * prm%burgers/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) -dUpper(1:ns,2) = prm%mu * prm%burgers/(4.0_pReal * PI * abs(tau)) - -where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) & - dUpper(1:ns,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(1:ns,1)) - -where(dNeq0(sqrt(sum(abs(rho(:,scr)),2)))) & - dUpper(1:ns,2) = min(1.0_pReal/sqrt(sum(abs(rho(:,scr)),2)),dUpper(1:ns,2)) - - -dUpper = max(dUpper,dLower) -deltaDUpper = dUpper - dUpperOld - - -!*** dissociation by stress increase -deltaRhoDipole2SingleStress = 0.0_pReal -forall (c=1:2, s=1:ns, deltaDUpper(s,c) < 0.0_pReal .and. & - dNeq0(dUpperOld(s,c) - dLower(s,c))) & - deltaRhoDipole2SingleStress(s,8+c) = rhoDip(s,c) * deltaDUpper(s,c) & - / (dUpperOld(s,c) - dLower(s,c)) - -forall (t=1:4) & - deltaRhoDipole2SingleStress(1:ns,t) = -0.5_pReal & - * deltaRhoDipole2SingleStress(1:ns,(t-1)/2+9) - - -!*** store new maximum dipole height in state -forall (s = 1:ns, c = 1:2) & - plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) - -plasticState(ph)%deltaState(:,of) = 0.0_pReal -del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) + integer :: & + ph, & !< phase + of, & !< offset + instance, & ! current instance of this plasticity + ns, & ! short notation for the total number of active slip systems + c, & ! character of dislocation + t, & ! type of dislocation + s ! index of my current slip system + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + deltaRhoRemobilization, & ! density increment by remobilization + deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + rho ! current dislocation densities + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + v ! dislocation glide velocity + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + tau ! current resolved shear stress + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) + dUpper, & ! current maximum stable dipole distance for edges and screws + dUpperOld, & ! old maximum stable dipole distance for edges and screws + deltaDUpper ! change in maximum stable dipole distance for edges and screws + + ph = phaseAt(1,ip,el) + of = phasememberAt(1,ip,el) + instance = phase_plasticityInstance(ph) + associate(prm => param(instance),dst => microstructure(instance),del => deltaState(instance)) + ns = totalNslip(instance) + + !*** shortcut to state variables + forall (s = 1:ns, t = 1:4) & + v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) + forall (s = 1:ns, c = 1:2) & + dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) + + rho = getRho(instance,of,ip,el) + rhoDip = rho(:,dip) + + !**************************************************************************** + !*** dislocation remobilization (bauschinger effect) + where(rho(:,imm) * v < 0.0_pReal) + deltaRhoRemobilization(:,mob) = abs(rho(:,imm)) + deltaRhoRemobilization(:,imm) = - rho(:,imm) + rho(:,mob) = rho(:,mob) + abs(rho(:,imm)) + rho(:,imm) = 0.0_pReal + elsewhere + deltaRhoRemobilization(:,mob) = 0.0_pReal + deltaRhoRemobilization(:,imm) = 0.0_pReal + endwhere + deltaRhoRemobilization(:,dip) = 0.0_pReal + + !**************************************************************************** + !*** calculate dipole formation and dissociation by stress change + + !*** calculate limits for stable dipole height + do s = 1,prm%totalNslip + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,of) + if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal + enddo + + dUpper(1:ns,1) = prm%mu * prm%burgers/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) + dUpper(1:ns,2) = prm%mu * prm%burgers/(4.0_pReal * PI * abs(tau)) + + where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) & + dUpper(1:ns,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(1:ns,1)) + + where(dNeq0(sqrt(sum(abs(rho(:,scr)),2)))) & + dUpper(1:ns,2) = min(1.0_pReal/sqrt(sum(abs(rho(:,scr)),2)),dUpper(1:ns,2)) + + + dUpper = max(dUpper,prm%minDipoleHeight) + deltaDUpper = dUpper - dUpperOld + + + !*** dissociation by stress increase + deltaRhoDipole2SingleStress = 0.0_pReal + forall (c=1:2, s=1:ns, deltaDUpper(s,c) < 0.0_pReal .and. & + dNeq0(dUpperOld(s,c) - prm%minDipoleHeight(s,c))) & + deltaRhoDipole2SingleStress(s,8+c) = rhoDip(s,c) * deltaDUpper(s,c) & + / (dUpperOld(s,c) - prm%minDipoleHeight(s,c)) + + forall (t=1:4) & + deltaRhoDipole2SingleStress(1:ns,t) = -0.5_pReal & + * deltaRhoDipole2SingleStress(1:ns,(t-1)/2+9) + + forall (s = 1:ns, c = 1:2) & + plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) + + plasticState(ph)%deltaState(:,of) = 0.0_pReal + del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) + #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & .and. ((debug_e == el .and. debug_i == ip)& @@ -1519,7 +1499,8 @@ del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [1 write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress endif #endif - end associate + + end associate end subroutine plastic_nonlocal_deltaState @@ -1529,223 +1510,228 @@ end subroutine plastic_nonlocal_deltaState !--------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & timestep,ip,el) -use, intrinsic :: & - IEEE_arithmetic -use prec, only: dNeq0, & - dNeq, & - dEq0 -use IO, only: IO_error + use, intrinsic :: & + IEEE_arithmetic + use prec, only: & + dNeq0, & + dNeq, & + dEq0 + use IO, only: & + IO_error #ifdef DEBUG -use debug, only: debug_level, & - debug_constitutive, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective, & - debug_i, & - debug_e + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelBasic, & + debug_levelExtensive, & + debug_levelSelective, & + debug_i, & + debug_e #endif -use math, only: math_mul3x3, & + use math, only: & #ifdef __PGI - norm2, & + norm2, & #endif - - math_mul33x3, & - math_mul33xx33, & - math_mul33x33, & - math_inv33, & - math_det33, & - pi -use mesh, only: theMesh, & - mesh_ipNeighborhood, & - mesh_ipVolume, & - mesh_ipArea, & - mesh_ipAreaNormal -use material, only: homogenization_maxNgrains, & - material_phase, & - phase_plasticityInstance, & - phase_localPlasticity, & - plasticState, & - phaseAt, phasememberAt, & - phase_plasticity ,& - PLASTICITY_NONLOCAL_ID -use lattice, only: lattice_structure, & - LATTICE_bcc_ID, & - LATTICE_fcc_ID - -implicit none - -!*** input variables -integer, intent(in) :: ip, & !< current integration point - el !< current element number -real(pReal), intent(in) :: Temperature, & !< temperature - timestep !< substepped crystallite time increment -real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress -real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & - Fe, & !< elastic deformation gradient - Fp !< plastic deformation gradient - - -!*** local variables -integer :: ph, & - instance, & !< current instance of this plasticity - neighbor_instance, & !< instance of my neighbor's plasticity - ns, & !< short notation for the total number of active slip systems - c, & !< character of dislocation - n, & !< index of my current neighbor - neighbor_el, & !< element number of my neighbor - neighbor_ip, & !< integration point of my neighbor - neighbor_n, & !< neighbor index pointing to me when looking from my neighbor - opposite_neighbor, & !< index of my opposite neighbor - opposite_ip, & !< ip of my opposite neighbor - opposite_el, & !< element index of my opposite neighbor - opposite_n, & !< neighbor index pointing to me when looking from my opposite neighbor - t, & !< type of dislocation - o,& !< offset shortcut - no,& !< neighbour offset shortcut - p,& !< phase shortcut - np,& !< neighbour phase shortcut - topp, & !< type of dislocation with opposite sign to t - s !< index of my current slip system -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & - rho, & - rhoDot, & !< density evolution - rhoDotMultiplication, & !< density evolution by multiplication - rhoDotFlux, & !< density evolution by flux - rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide) - rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation - rhoDotThermalAnnihilation !< density evolution by thermal annihilation -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & - rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) - neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) - my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & - v, & !< current dislocation glide velocity - my_v, & !< dislocation glide velocity of central ip - neighbor_v, & !< dislocation glide velocity of enighboring ip - gdot !< shear rates -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - tau, & !< current resolved shear stress - vClimb !< climb velocity of edge dipoles - -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & - rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) - dLower, & !< minimum stable dipole distance for edges and screws - dUpper !< current maximum stable dipole distance for edges and screws -real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & - m !< direction of dislocation motion -real(pReal), dimension(3,3) :: my_F, & !< my total deformation gradient - neighbor_F, & !< total deformation gradient of my neighbor - my_Fe, & !< my elastic deformation gradient - neighbor_Fe, & !< elastic deformation gradient of my neighbor - Favg !< average total deformation gradient of me and my neighbor -real(pReal), dimension(3) :: normal_neighbor2me, & !< interface normal pointing from my neighbor to me in neighbor's lattice configuration - normal_neighbor2me_defConf, & !< interface normal pointing from my neighbor to me in shared deformed configuration - normal_me2neighbor, & !< interface normal pointing from me to my neighbor in my lattice configuration - normal_me2neighbor_defConf !< interface normal pointing from me to my neighbor in shared deformed configuration -real(pReal) area, & !< area of the current interface - transmissivity, & !< overall transmissivity of dislocation flux to neighboring material point - lineLength, & !< dislocation line length leaving the current interface - selfDiffusion !< self diffusion - -logical considerEnteringFlux, & - considerLeavingFlux - - - p = phaseAt(1,ip,el) - o = phasememberAt(1,ip,el) - -if (timestep <= 0.0_pReal) then ! if illegal timestep... - plasticState(p)%dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) - return -endif - -ph = material_phase(1,ip,el) -instance = phase_plasticityInstance(ph) -associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance),stt => state(instance)) -ns = totalNslip(instance) - -tau = 0.0_pReal -gdot = 0.0_pReal - -rho = getRho(instance,o,ip,el) -rhoSgl = rho(:,sgl) -rhoDip = rho(:,dip) - -forall (s = 1:ns, t = 1:4) - v(s,t) = plasticState(p)%state(iV (s,t,instance),o) -endforall - - -!**************************************************************************** -!*** Calculate shear rate - -forall (t = 1:4) & - gdot(1:ns,t) = rhoSgl(1:ns,t) * prm%burgers(1:ns) * v(1:ns,t) - -#ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0 & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then - write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip - write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot + math_mul3x3, & + math_mul33x3, & + math_mul33xx33, & + math_mul33x33, & + math_inv33, & + math_det33, & + PI + use mesh, only: & + theMesh, & + mesh_ipNeighborhood, & + mesh_ipVolume, & + mesh_ipArea, & + mesh_ipAreaNormal + use material, only: & + homogenization_maxNgrains, & + material_phase, & + phase_plasticityInstance, & + phase_localPlasticity, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticity ,& + PLASTICITY_NONLOCAL_ID + use lattice, only: & + lattice_structure, & + LATTICE_bcc_ID, & + LATTICE_fcc_ID + + implicit none + integer, intent(in) :: & + ip, & !< current integration point + el !< current element number + real(pReal), intent(in) :: & + Temperature, & !< temperature + timestep !< substepped crystallite time increment + real(pReal), dimension(3,3), intent(in) ::& + Mp !< MandelStress + real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & + Fe, & !< elastic deformation gradient + Fp !< plastic deformation gradient + + integer :: & + ph, & + instance, & !< current instance of this plasticity + neighbor_instance, & !< instance of my neighbor's plasticity + ns, & !< short notation for the total number of active slip systems + c, & !< character of dislocation + n, & !< index of my current neighbor + neighbor_el, & !< element number of my neighbor + neighbor_ip, & !< integration point of my neighbor + neighbor_n, & !< neighbor index pointing to me when looking from my neighbor + opposite_neighbor, & !< index of my opposite neighbor + opposite_ip, & !< ip of my opposite neighbor + opposite_el, & !< element index of my opposite neighbor + opposite_n, & !< neighbor index pointing to me when looking from my opposite neighbor + t, & !< type of dislocation + o,& !< offset shortcut + no,& !< neighbour offset shortcut + p,& !< phase shortcut + np,& !< neighbour phase shortcut + topp, & !< type of dislocation with opposite sign to t + s !< index of my current slip system + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + rho, & + rhoDot, & !< density evolution + rhoDotMultiplication, & !< density evolution by multiplication + rhoDotFlux, & !< density evolution by flux + rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide) + rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation + rhoDotThermalAnnihilation !< density evolution by thermal annihilation + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & + rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) + neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) + my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + v, & !< current dislocation glide velocity + my_v, & !< dislocation glide velocity of central ip + neighbor_v, & !< dislocation glide velocity of enighboring ip + gdot !< shear rates + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + tau, & !< current resolved shear stress + vClimb !< climb velocity of edge dipoles + + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) + dLower, & !< minimum stable dipole distance for edges and screws + dUpper !< current maximum stable dipole distance for edges and screws + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + m !< direction of dislocation motion + real(pReal), dimension(3,3) :: & + my_F, & !< my total deformation gradient + neighbor_F, & !< total deformation gradient of my neighbor + my_Fe, & !< my elastic deformation gradient + neighbor_Fe, & !< elastic deformation gradient of my neighbor + Favg !< average total deformation gradient of me and my neighbor + real(pReal), dimension(3) :: & + normal_neighbor2me, & !< interface normal pointing from my neighbor to me in neighbor's lattice configuration + normal_neighbor2me_defConf, & !< interface normal pointing from my neighbor to me in shared deformed configuration + normal_me2neighbor, & !< interface normal pointing from me to my neighbor in my lattice configuration + normal_me2neighbor_defConf !< interface normal pointing from me to my neighbor in shared deformed configuration + real(pReal) :: & + area, & !< area of the current interface + transmissivity, & !< overall transmissivity of dislocation flux to neighboring material point + lineLength, & !< dislocation line length leaving the current interface + selfDiffusion !< self diffusion + + logical :: & + considerEnteringFlux, & + considerLeavingFlux + + p = phaseAt(1,ip,el) + o = phasememberAt(1,ip,el) + + if (timestep <= 0.0_pReal) then + plasticState(p)%dotState = 0.0_pReal + return endif -#endif - - - -!**************************************************************************** -!*** calculate limits for stable dipole height - -do s = 1,ns ! loop over slip systems - tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,o) - if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal -enddo - -dLower = prm%minDipoleHeight(1:ns,1:2) -dUpper(1:ns,1) = prm%mu * prm%burgers/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) -dUpper(1:ns,2) = prm%mu * prm%burgers/(4.0_pReal * PI * abs(tau)) -do c = 1, 2 - where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& - +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & - dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & - + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & - dUpper(1:ns,c)) -enddo -dUpper = max(dUpper,dLower) - -!**************************************************************************** -!*** calculate dislocation multiplication -rhoDotMultiplication = 0.0_pReal -if (lattice_structure(ph) == LATTICE_bcc_ID) then ! BCC - forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) - rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(stt%rho_forest(s,o)) / prm%lambda0(s) ! & ! mean free path - ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation - rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) /prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(stt%rho_forest(s,o)) / prm%lambda0(s) ! & ! mean free path - ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation + + ph = material_phase(1,ip,el) + instance = phase_plasticityInstance(ph) + associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance),stt => state(instance)) + ns = totalNslip(instance) + + tau = 0.0_pReal + gdot = 0.0_pReal + + rho = getRho(instance,o,ip,el) + rhoSgl = rho(:,sgl) + rhoDip = rho(:,dip) + + forall (s = 1:ns, t = 1:4) + v(s,t) = plasticState(p)%state(iV (s,t,instance),o) endforall - -else ! ALL OTHER STRUCTURES - rhoDotMultiplication(1:ns,1:4) = spread( & - (sum(abs(gdot(1:ns,1:2)),2) * prm%fEdgeMultiplication + sum(abs(gdot(1:ns,3:4)),2)) & - * sqrt(stt%rho_forest(:,o)) / prm%lambda0 / prm%burgers(1:ns), 2, 4) -endif - - - -!**************************************************************************** -!*** calculate dislocation fluxes (only for nonlocal plasticity) - -rhoDotFlux = 0.0_pReal -!? why needed here -if (.not. phase_localPlasticity(material_phase(1,ip,el))) then ! only for nonlocal plasticity - - !*** check CFL (Courant-Friedrichs-Lewy) condition for flux - - if (any( abs(gdot) > 0.0_pReal & ! any active slip system ... - .and. prm%CFLfactor * abs(v) * timestep & - > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) + + + !**************************************************************************** + !*** Calculate shear rate + + forall (t = 1:4) & + gdot(1:ns,t) = rhoSgl(1:ns,t) * prm%burgers(1:ns) * v(1:ns,t) + +#ifdef DEBUG + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0 & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then + write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip + write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot + endif +#endif + + + + !**************************************************************************** + !*** calculate limits for stable dipole height + + do s = 1,ns ! loop over slip systems + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,o) + if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal + enddo + + dLower = prm%minDipoleHeight(1:ns,1:2) + dUpper(1:ns,1) = prm%mu * prm%burgers/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) + dUpper(1:ns,2) = prm%mu * prm%burgers/(4.0_pReal * PI * abs(tau)) + do c = 1, 2 + where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& + +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & + dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & + dUpper(1:ns,c)) + enddo + dUpper = max(dUpper,dLower) + + !**************************************************************************** + !*** calculate dislocation multiplication + rhoDotMultiplication = 0.0_pReal + isBCC: if (lattice_structure(ph) == LATTICE_bcc_ID) then + forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) + rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication + * sqrt(stt%rho_forest(s,o)) / prm%lambda0(s) ! & ! mean free path + ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation + rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) /prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication + * sqrt(stt%rho_forest(s,o)) / prm%lambda0(s) ! & ! mean free path + ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation + endforall + + else isBCC + rhoDotMultiplication(1:ns,1:4) = spread( & + (sum(abs(gdot(1:ns,1:2)),2) * prm%fEdgeMultiplication + sum(abs(gdot(1:ns,3:4)),2)) & + * sqrt(stt%rho_forest(:,o)) / prm%lambda0 / prm%burgers(1:ns), 2, 4) + endif isBCC + + + !**************************************************************************** + !*** calculate dislocation fluxes (only for nonlocal plasticity) + rhoDotFlux = 0.0_pReal + if (.not. phase_localPlasticity(material_phase(1,ip,el))) then + + !*** check CFL (Courant-Friedrichs-Lewy) condition for flux + if (any( abs(gdot) > 0.0_pReal & ! any active slip system ... + .and. prm%CFLfactor * abs(v) * timestep & + > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip @@ -1757,229 +1743,223 @@ if (.not. phase_localPlasticity(material_phase(1,ip,el))) then write(6,'(a)') '<< CONST >> enforcing cutback !!!' endif #endif - plasticState(p)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) ! -> return NaN and, hence, enforce cutback - return - endif - - - !*** be aware of the definition of slip_transverse = slip_direction x slip_normal !!! - !*** opposite sign to our p vector in the (s,p,n) triplet !!! - - m(1:3,1:ns,1) = prm%slip_direction - m(1:3,1:ns,2) = -prm%slip_direction - m(1:3,1:ns,3) = -prm%slip_transverse - m(1:3,1:ns,4) = prm%slip_transverse - - my_Fe = Fe(1:3,1:3,1,ip,el) - my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1,ip,el)) - - do n = 1,theMesh%elem%nIPneighbors - - neighbor_el = mesh_ipNeighborhood(1,n,ip,el) - neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) - neighbor_n = mesh_ipNeighborhood(3,n,ip,el) - np = phaseAt(1,neighbor_ip,neighbor_el) - no = phasememberAt(1,neighbor_ip,neighbor_el) - - opposite_neighbor = n + mod(n,2) - mod(n+1,2) - opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el) - opposite_ip = mesh_ipNeighborhood(2,opposite_neighbor,ip,el) - opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el) - - if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient - neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) - neighbor_Fe = Fe(1:3,1:3,1,neighbor_ip,neighbor_el) - neighbor_F = math_mul33x33(neighbor_Fe, Fp(1:3,1:3,1,neighbor_ip,neighbor_el)) - Favg = 0.5_pReal * (my_F + neighbor_F) - else ! if no neighbor, take my value as average - Favg = my_F + plasticState(p)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) ! -> return NaN and, hence, enforce cutback + return endif + + + !*** be aware of the definition of slip_transverse = slip_direction x slip_normal !!! + !*** opposite sign to our p vector in the (s,p,n) triplet !!! - - !* FLUX FROM MY NEIGHBOR TO ME - !* This is only considered, if I have a neighbor of nonlocal plasticity - !* (also nonlocal constitutive law with local properties) that is at least a little bit - !* compatible. - !* If it's not at all compatible, no flux is arriving, because everything is dammed in front of - !* my neighbor's interface. - !* The entering flux from my neighbor will be distributed on my slip systems according to the - !*compatibility + m(1:3,1:ns,1) = prm%slip_direction + m(1:3,1:ns,2) = -prm%slip_direction + m(1:3,1:ns,3) = -prm%slip_transverse + m(1:3,1:ns,4) = prm%slip_transverse - considerEnteringFlux = .false. - neighbor_v = 0.0_pReal ! needed for check of sign change in flux density below - neighbor_rhoSgl = 0.0_pReal - if (neighbor_n > 0) then - if (phase_plasticity(material_phase(1,neighbor_ip,neighbor_el)) == PLASTICITY_NONLOCAL_ID & - .and. any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) & - considerEnteringFlux = .true. - endif + my_Fe = Fe(1:3,1:3,1,ip,el) + my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1,ip,el)) - if (considerEnteringFlux) then - forall (s = 1:ns, t = 1:4) - neighbor_v(s,t) = plasticState(np)%state(iV (s,t,neighbor_instance),no) - neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance),no), & - 0.0_pReal) - endforall - - where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN & - .or. neighbor_rhoSgl < prm%significantRho) & - neighbor_rhoSgl = 0.0_pReal - normal_neighbor2me_defConf = math_det33(Favg) * math_mul33x3(math_inv33(transpose(Favg)), & - mesh_ipAreaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!) - normal_neighbor2me = math_mul33x3(transpose(neighbor_Fe), normal_neighbor2me_defConf) & - / math_det33(neighbor_Fe) ! interface normal in the lattice configuration of my neighbor - area = mesh_ipArea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me) - normal_neighbor2me = normal_neighbor2me / norm2(normal_neighbor2me) ! normalize the surface normal to unit length - do s = 1,ns - do t = 1,4 - c = (t + 1) / 2 - topp = t + mod(t,2) - mod(t+1,2) - if (neighbor_v(s,t) * math_mul3x3(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me - .and. v(s,t) * neighbor_v(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density - lineLength = neighbor_rhoSgl(s,t) * neighbor_v(s,t) & - * math_mul3x3(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface - where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility... - rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) & - + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type - * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal - where (compatibility(c,1:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility... - rhoDotFlux(1:ns,topp) = rhoDotFlux(1:ns,topp) & - + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type - * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal - endif - enddo - enddo - endif - - - !* FLUX FROM ME TO MY NEIGHBOR - !* This is not considered, if my opposite neighbor has a different constitutive law than nonlocal (still considered for nonlocal law with local properties). - !* Then, we assume, that the opposite(!) neighbor sends an equal amount of dislocations to me. - !* So the net flux in the direction of my neighbor is equal to zero: - !* leaving flux to neighbor == entering flux from opposite neighbor - !* In case of reduced transmissivity, part of the leaving flux is stored as dead dislocation density. - !* That means for an interface of zero transmissivity the leaving flux is fully converted to dead dislocations. + neighbors: do n = 1,theMesh%elem%nIPneighbors + + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) + neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) + neighbor_n = mesh_ipNeighborhood(3,n,ip,el) + np = phaseAt(1,neighbor_ip,neighbor_el) + no = phasememberAt(1,neighbor_ip,neighbor_el) + + opposite_neighbor = n + mod(n,2) - mod(n+1,2) + opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el) + opposite_ip = mesh_ipNeighborhood(2,opposite_neighbor,ip,el) + opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el) - considerLeavingFlux = .true. - if (opposite_n > 0) then - if (phase_plasticity(material_phase(1,opposite_ip,opposite_el)) /= PLASTICITY_NONLOCAL_ID) & - considerLeavingFlux = .false. - endif - - if (considerLeavingFlux) then - my_rhoSgl = rhoSgl - my_v = v + if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient + neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) + neighbor_Fe = Fe(1:3,1:3,1,neighbor_ip,neighbor_el) + neighbor_F = math_mul33x33(neighbor_Fe, Fp(1:3,1:3,1,neighbor_ip,neighbor_el)) + Favg = 0.5_pReal * (my_F + neighbor_F) + else ! if no neighbor, take my value as average + Favg = my_F + endif - normal_me2neighbor_defConf = math_det33(Favg) & - * math_mul33x3(math_inv33(transpose(Favg)), & - mesh_ipAreaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!) - normal_me2neighbor = math_mul33x3(transpose(my_Fe), normal_me2neighbor_defConf) & - / math_det33(my_Fe) ! interface normal in my lattice configuration - area = mesh_ipArea(n,ip,el) * norm2(normal_me2neighbor) - normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length - do s = 1,ns - do t = 1,4 - c = (t + 1) / 2 - if (my_v(s,t) * math_mul3x3(m(1:3,s,t), normal_me2neighbor) > 0.0_pReal ) then ! flux from me to my neighbor == leaving flux for me (might also be a pure flux from my mobile density to dead density if interface not at all transmissive) - if (my_v(s,t) * neighbor_v(s,t) >= 0.0_pReal) then ! no sign change in flux density - transmissivity = sum(compatibility(c,1:ns,s,n,ip,el)**2.0_pReal) ! overall transmissivity from this slip system to my neighbor - else ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor - transmissivity = 0.0_pReal + + !* FLUX FROM MY NEIGHBOR TO ME + !* This is only considered, if I have a neighbor of nonlocal plasticity + !* (also nonlocal constitutive law with local properties) that is at least a little bit + !* compatible. + !* If it's not at all compatible, no flux is arriving, because everything is dammed in front of + !* my neighbor's interface. + !* The entering flux from my neighbor will be distributed on my slip systems according to the + !*compatibility + + considerEnteringFlux = .false. + neighbor_v = 0.0_pReal ! needed for check of sign change in flux density below + neighbor_rhoSgl = 0.0_pReal + if (neighbor_n > 0) then + if (phase_plasticity(material_phase(1,neighbor_ip,neighbor_el)) == PLASTICITY_NONLOCAL_ID & + .and. any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) & + considerEnteringFlux = .true. + endif + + enteringFlux: if (considerEnteringFlux) then + forall (s = 1:ns, t = 1:4) + neighbor_v(s,t) = plasticState(np)%state(iV (s,t,neighbor_instance),no) + neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance),no), & + 0.0_pReal) + endforall + + where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN & + .or. neighbor_rhoSgl < prm%significantRho) & + neighbor_rhoSgl = 0.0_pReal + normal_neighbor2me_defConf = math_det33(Favg) * math_mul33x3(math_inv33(transpose(Favg)), & + mesh_ipAreaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!) + normal_neighbor2me = math_mul33x3(transpose(neighbor_Fe), normal_neighbor2me_defConf) & + / math_det33(neighbor_Fe) ! interface normal in the lattice configuration of my neighbor + area = mesh_ipArea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me) + normal_neighbor2me = normal_neighbor2me / norm2(normal_neighbor2me) ! normalize the surface normal to unit length + do s = 1,ns + do t = 1,4 + c = (t + 1) / 2 + topp = t + mod(t,2) - mod(t+1,2) + if (neighbor_v(s,t) * math_mul3x3(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me + .and. v(s,t) * neighbor_v(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density + lineLength = neighbor_rhoSgl(s,t) * neighbor_v(s,t) & + * math_mul3x3(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface + where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility... + rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) & + + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type + * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal + where (compatibility(c,1:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility... + rhoDotFlux(1:ns,topp) = rhoDotFlux(1:ns,topp) & + + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type + * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal endif - lineLength = my_rhoSgl(s,t) * my_v(s,t) & - * math_mul3x3(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface - rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / mesh_ipVolume(ip,el) ! subtract dislocation flux from current type - rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) & - + lineLength / mesh_ipVolume(ip,el) * (1.0_pReal - transmissivity) & - * sign(1.0_pReal, my_v(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point - endif + enddo enddo - enddo - endif + endif enteringFlux + + + !* FLUX FROM ME TO MY NEIGHBOR + !* This is not considered, if my opposite neighbor has a different constitutive law than nonlocal (still considered for nonlocal law with local properties). + !* Then, we assume, that the opposite(!) neighbor sends an equal amount of dislocations to me. + !* So the net flux in the direction of my neighbor is equal to zero: + !* leaving flux to neighbor == entering flux from opposite neighbor + !* In case of reduced transmissivity, part of the leaving flux is stored as dead dislocation density. + !* That means for an interface of zero transmissivity the leaving flux is fully converted to dead dislocations. + + considerLeavingFlux = .true. + if (opposite_n > 0) then + if (phase_plasticity(material_phase(1,opposite_ip,opposite_el)) /= PLASTICITY_NONLOCAL_ID) & + considerLeavingFlux = .false. + endif + + leavingFlux: if (considerLeavingFlux) then + my_rhoSgl = rhoSgl + my_v = v + + normal_me2neighbor_defConf = math_det33(Favg) & + * math_mul33x3(math_inv33(transpose(Favg)), & + mesh_ipAreaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!) + normal_me2neighbor = math_mul33x3(transpose(my_Fe), normal_me2neighbor_defConf) & + / math_det33(my_Fe) ! interface normal in my lattice configuration + area = mesh_ipArea(n,ip,el) * norm2(normal_me2neighbor) + normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length + do s = 1,ns + do t = 1,4 + c = (t + 1) / 2 + if (my_v(s,t) * math_mul3x3(m(1:3,s,t), normal_me2neighbor) > 0.0_pReal ) then ! flux from me to my neighbor == leaving flux for me (might also be a pure flux from my mobile density to dead density if interface not at all transmissive) + if (my_v(s,t) * neighbor_v(s,t) >= 0.0_pReal) then ! no sign change in flux density + transmissivity = sum(compatibility(c,1:ns,s,n,ip,el)**2.0_pReal) ! overall transmissivity from this slip system to my neighbor + else ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor + transmissivity = 0.0_pReal + endif + lineLength = my_rhoSgl(s,t) * my_v(s,t) & + * math_mul3x3(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface + rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / mesh_ipVolume(ip,el) ! subtract dislocation flux from current type + rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) & + + lineLength / mesh_ipVolume(ip,el) * (1.0_pReal - transmissivity) & + * sign(1.0_pReal, my_v(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point + endif + enddo + enddo + endif leavingFlux + + enddo neighbors + endif + + + + !**************************************************************************** + !*** calculate dipole formation and annihilation + + !*** formation by glide + + do c = 1,2 + rhoDotSingle2DipoleGlide(1:ns,2*c-1) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & + * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile + + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile + + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) ! positive mobile --> negative immobile + + rhoDotSingle2DipoleGlide(1:ns,2*c) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & + * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile + + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile + + abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c))) ! negative mobile --> positive immobile + + rhoDotSingle2DipoleGlide(1:ns,2*c+3) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & + * rhoSgl(1:ns,2*c+3) * abs(gdot(1:ns,2*c)) ! negative mobile --> positive immobile + + rhoDotSingle2DipoleGlide(1:ns,2*c+4) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns)& + * rhoSgl(1:ns,2*c+4) * abs(gdot(1:ns,2*c-1)) ! positive mobile --> negative immobile + + rhoDotSingle2DipoleGlide(1:ns,c+8) = - rhoDotSingle2DipoleGlide(1:ns,2*c-1) & + - rhoDotSingle2DipoleGlide(1:ns,2*c) & + + abs(rhoDotSingle2DipoleGlide(1:ns,2*c+3)) & + + abs(rhoDotSingle2DipoleGlide(1:ns,2*c+4)) + enddo + + + !*** athermal annihilation + + rhoDotAthermalAnnihilation = 0.0_pReal + + forall (c=1:2) & + rhoDotAthermalAnnihilation(1:ns,c+8) = -2.0_pReal * dLower(1:ns,c) / prm%burgers(1:ns) & + * ( 2.0_pReal * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1))) & ! was single hitting single + + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single + + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent + ! annihilated screw dipoles leave edge jogs behind on the colinear system + + if (lattice_structure(ph) == LATTICE_fcc_ID) & + forall (s = 1:ns, prm%colinearSystem(s) > 0) & + rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & + * 0.25_pReal * sqrt(stt%rho_forest(s,o)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor + - enddo ! neighbor loop -endif - - - -!**************************************************************************** -!*** calculate dipole formation and annihilation - -!*** formation by glide - -do c = 1,2 - rhoDotSingle2DipoleGlide(1:ns,2*c-1) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & - * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile - + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile - + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) ! positive mobile --> negative immobile - - rhoDotSingle2DipoleGlide(1:ns,2*c) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & - * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile - + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile - + abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c))) ! negative mobile --> positive immobile - - rhoDotSingle2DipoleGlide(1:ns,2*c+3) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & - * rhoSgl(1:ns,2*c+3) * abs(gdot(1:ns,2*c)) ! negative mobile --> positive immobile - - rhoDotSingle2DipoleGlide(1:ns,2*c+4) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns)& - * rhoSgl(1:ns,2*c+4) * abs(gdot(1:ns,2*c-1)) ! positive mobile --> negative immobile - - rhoDotSingle2DipoleGlide(1:ns,c+8) = - rhoDotSingle2DipoleGlide(1:ns,2*c-1) & - - rhoDotSingle2DipoleGlide(1:ns,2*c) & - + abs(rhoDotSingle2DipoleGlide(1:ns,2*c+3)) & - + abs(rhoDotSingle2DipoleGlide(1:ns,2*c+4)) -enddo - - -!*** athermal annihilation - -rhoDotAthermalAnnihilation = 0.0_pReal - -forall (c=1:2) & - rhoDotAthermalAnnihilation(1:ns,c+8) = -2.0_pReal * dLower(1:ns,c) / prm%burgers(1:ns) & - * ( 2.0_pReal * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1))) & ! was single hitting single - + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single - + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent -! annihilated screw dipoles leave edge jogs behind on the colinear system - -if (lattice_structure(ph) == LATTICE_fcc_ID) & - forall (s = 1:ns, prm%colinearSystem(s) > 0) & - rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & - * 0.25_pReal * sqrt(stt%rho_forest(s,o)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor - + + !*** thermally activated annihilation of edge dipoles by climb + rhoDotThermalAnnihilation = 0.0_pReal + selfDiffusion = prm%Dsd0 * exp(-prm%selfDiffusionEnergy / (KB * Temperature)) + vClimb = prm%atomicVolume * selfDiffusion / ( KB * Temperature ) & + * prm%mu / ( 2.0_pReal * PI * (1.0_pReal-prm%nu) ) & + * 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) ) + forall (s = 1:ns, dUpper(s,1) > dLower(s,1)) & + rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), & + - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & + - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have + + rhoDot = 0.0_pReal + rhoDot = rhoDotFlux & + + rhoDotMultiplication & + + rhoDotSingle2DipoleGlide & + + rhoDotAthermalAnnihilation & + + rhoDotThermalAnnihilation -!*** thermally activated annihilation of edge dipoles by climb - -rhoDotThermalAnnihilation = 0.0_pReal -selfDiffusion = prm%Dsd0 * exp(-prm%selfDiffusionEnergy / (KB * Temperature)) -vClimb = prm%atomicVolume * selfDiffusion / ( KB * Temperature ) & - * prm%mu / ( 2.0_pReal * PI * (1.0_pReal-prm%nu) ) & - * 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) ) -forall (s = 1:ns, dUpper(s,1) > dLower(s,1)) & - rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), & - - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have - - - -!**************************************************************************** -!*** assign the rates of dislocation densities to my dotState -!*** if evolution rates lead to negative densities, a cutback is enforced - -rhoDot = 0.0_pReal -rhoDot = rhoDotFlux & - + rhoDotMultiplication & - + rhoDotSingle2DipoleGlide & - + rhoDotAthermalAnnihilation & - + rhoDotThermalAnnihilation - -results(instance)%rhoDotFlux(1:ns,1:8,o) = rhoDotFlux(1:ns,1:8) -results(instance)%rhoDotMultiplication(1:ns,1:2,o) = rhoDotMultiplication(1:ns,[1,3]) -results(instance)%rhoDotSingle2DipoleGlide(1:ns,1:2,o) = rhoDotSingle2DipoleGlide(1:ns,9:10) -results(instance)%rhoDotAthermalAnnihilation(1:ns,1:2,o) = rhoDotAthermalAnnihilation(1:ns,9:10) -results(instance)%rhoDotThermalAnnihilation(1:ns,1:2,o) = rhoDotThermalAnnihilation(1:ns,9:10) -results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) + results(instance)%rhoDotFlux(1:ns,1:8,o) = rhoDotFlux(1:ns,1:8) + results(instance)%rhoDotMultiplication(1:ns,1:2,o) = rhoDotMultiplication(1:ns,[1,3]) + results(instance)%rhoDotSingle2DipoleGlide(1:ns,1:2,o) = rhoDotSingle2DipoleGlide(1:ns,9:10) + results(instance)%rhoDotAthermalAnnihilation(1:ns,1:2,o) = rhoDotAthermalAnnihilation(1:ns,9:10) + results(instance)%rhoDotThermalAnnihilation(1:ns,1:2,o) = rhoDotThermalAnnihilation(1:ns,9:10) + results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) #ifdef DEBUG @@ -2006,239 +1986,235 @@ results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation #endif -if ( any(rho(:,mob) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & - .or. any(rho(:,dip) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then + if ( any(rho(:,mob) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & + .or. any(rho(:,dip) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then - write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip - write(6,'(a)') '<< CONST >> enforcing cutback !!!' - endif + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then + write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip + write(6,'(a)') '<< CONST >> enforcing cutback !!!' + endif #endif - plasticState(p)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) - return -else - forall (s = 1:ns, t = 1:4) - plasticState(p)%dotState(iRhoU(s,t,instance),o) = rhoDot(s,t) - plasticState(p)%dotState(iRhoB(s,t,instance),o) = rhoDot(s,t+4) - endforall - forall (s = 1:ns, c = 1:2) & - plasticState(p)%dotState(iRhoD(s,c,instance),o) = rhoDot(s,c+8) - forall (s = 1:ns) & - dot%accumulatedshear(s,o) = sum(gdot(s,1:4)) -endif - end associate + plasticState(p)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) + return + else + forall (s = 1:ns, t = 1:4) + plasticState(p)%dotState(iRhoU(s,t,instance),o) = rhoDot(s,t) + plasticState(p)%dotState(iRhoB(s,t,instance),o) = rhoDot(s,t+4) + endforall + forall (s = 1:ns, c = 1:2) & + plasticState(p)%dotState(iRhoD(s,c,instance),o) = rhoDot(s,c+8) + forall (s = 1:ns) & + dot%accumulatedshear(s,o) = sum(gdot(s,1:4)) + endif + + end associate + end subroutine plastic_nonlocal_dotState - -!********************************************************************* -!* COMPATIBILITY UPDATE * -!* Compatibility is defined as normalized product of signed cosine * -!* of the angle between the slip plane normals and signed cosine of * -!* the angle between the slip directions. Only the largest values * -!* that sum up to a total of 1 are considered, all others are set to * -!* zero. * -!********************************************************************* +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!> @detail Compatibility is defined as normalized product of signed cosine of the angle between the slip +! plane normals and signed cosine of the angle between the slip directions. Only the largest values +! that sum up to a total of 1 are considered, all others are set to zero. +!-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) -use math, only: math_mul3x3, math_qRot -use rotations, only: rotation -use material, only: material_phase, & - material_texture, & - phase_localPlasticity, & - phase_plasticityInstance -use mesh, only: mesh_ipNeighborhood, & - theMesh -use lattice, only: lattice_qDisorientation - -implicit none - -!* input variables -integer, intent(in) :: i, & ! ip index - e ! element index -type(rotation), dimension(1,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & - orientation ! crystal orientation in quaternions - -!* local variables -integer Nneighbors, & ! number of neighbors - n, & ! neighbor index - neighbor_e, & ! element index of my neighbor - neighbor_i, & ! integration point index of my neighbor - ph, & - neighbor_phase, & - textureID, & - neighbor_textureID, & - instance, & ! instance of plasticity - ns, & ! number of active slip systems - s1, & ! slip system index (me) - s2 ! slip system index (my neighbor) -real(pReal), dimension(4) :: absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor -real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& - totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& - theMesh%elem%nIPneighbors) :: & - my_compatibility ! my_compatibility for current element and ip -real(pReal) :: my_compatibilitySum, & - thresholdValue, & - nThresholdValues -logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & - belowThreshold -type(rotation) :: rot - -Nneighbors = theMesh%elem%nIPneighbors -ph = material_phase(1,i,e) -textureID = material_texture(1,i,e) -instance = phase_plasticityInstance(ph) -ns = totalNslip(instance) -associate(prm => param(instance)) - -!*** start out fully compatible - -my_compatibility = 0.0_pReal -forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal - -!*** Loop thrugh neighbors and check whether there is any my_compatibility. - -neighbors: do n = 1,Nneighbors - neighbor_e = mesh_ipNeighborhood(1,n,i,e) - neighbor_i = mesh_ipNeighborhood(2,n,i,e) + use math, only: & + math_mul3x3, & + math_qRot + use rotations, only: & + rotation + use material, only: & + material_phase, & + material_texture, & + phase_localPlasticity, & + phase_plasticityInstance + use mesh, only: & + mesh_ipNeighborhood, & + theMesh + use lattice, only: & + lattice_qDisorientation - - !* FREE SURFACE - !* Set surface transmissivity to the value specified in the material.config - - if (neighbor_e <= 0 .or. neighbor_i <= 0) then - forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,n) = sqrt(prm%surfaceTransmissivity) - cycle - endif - - - !* PHASE BOUNDARY - !* If we encounter a different nonlocal "cpfem" phase at the neighbor, - !* we consider this to be a real "physical" phase boundary, so completely incompatible. - !* If one of the two "CPFEM" phases has a local plasticity law, - !* we do not consider this to be a phase boundary, so completely compatible. - - neighbor_phase = material_phase(1,neighbor_i,neighbor_e) - if (neighbor_phase /= ph) then - if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph))& - forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,n) = 0.0_pReal - cycle - endif + implicit none + integer, intent(in) :: & + i, & + e + type(rotation), dimension(1,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & + orientation ! crystal orientation in quaternions + + integer :: & + Nneighbors, & ! number of neighbors + n, & ! neighbor index + neighbor_e, & ! element index of my neighbor + neighbor_i, & ! integration point index of my neighbor + ph, & + neighbor_phase, & + textureID, & + neighbor_textureID, & + instance, & ! instance of plasticity + ns, & ! number of active slip systems + s1, & ! slip system index (me) + s2 ! slip system index (my neighbor) + real(pReal), dimension(4) :: & + absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor + real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& + totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& + theMesh%elem%nIPneighbors) :: & + my_compatibility ! my_compatibility for current element and ip + real(pReal) :: & + my_compatibilitySum, & + thresholdValue, & + nThresholdValues + logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & + belowThreshold + type(rotation) :: rot + Nneighbors = theMesh%elem%nIPneighbors + ph = material_phase(1,i,e) + textureID = material_texture(1,i,e) + instance = phase_plasticityInstance(ph) + ns = totalNslip(instance) + associate(prm => param(instance)) + + !*** start out fully compatible + my_compatibility = 0.0_pReal + + forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal + + !*** Loop thrugh neighbors and check whether there is any my_compatibility. + + neighbors: do n = 1,Nneighbors + neighbor_e = mesh_ipNeighborhood(1,n,i,e) + neighbor_i = mesh_ipNeighborhood(2,n,i,e) - !* GRAIN BOUNDARY ! - !* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config) - - if (prm%grainboundaryTransmissivity >= 0.0_pReal) then - neighbor_textureID = material_texture(1,neighbor_i,neighbor_e) - if (neighbor_textureID /= textureID) then - if (.not. phase_localPlasticity(neighbor_phase)) then - forall(s1 = 1:ns) & - my_compatibility(1:2,s1,s1,n) = sqrt(prm%grainboundaryTransmissivity) - endif + + !* FREE SURFACE + !* Set surface transmissivity to the value specified in the material.config + + if (neighbor_e <= 0 .or. neighbor_i <= 0) then + forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,n) = sqrt(prm%surfaceTransmissivity) + cycle + endif + + + !* PHASE BOUNDARY + !* If we encounter a different nonlocal "cpfem" phase at the neighbor, + !* we consider this to be a real "physical" phase boundary, so completely incompatible. + !* If one of the two "CPFEM" phases has a local plasticity law, + !* we do not consider this to be a phase boundary, so completely compatible. + + neighbor_phase = material_phase(1,neighbor_i,neighbor_e) + if (neighbor_phase /= ph) then + if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph))& + forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,n) = 0.0_pReal cycle endif - - !* GRAIN BOUNDARY ? - !* Compatibility defined by relative orientation of slip systems: - !* The my_compatibility value is defined as the product of the slip normal projection and the slip direction projection. - !* Its sign is always positive for screws, for edges it has the same sign as the slip normal projection. - !* Since the sum for each slip system can easily exceed one (which would result in a transmissivity larger than one), - !* only values above or equal to a certain threshold value are considered. This threshold value is chosen, such that - !* the number of compatible slip systems is minimized with the sum of the original my_compatibility values exceeding one. - !* Finally the smallest my_compatibility value is decreased until the sum is exactly equal to one. - !* All values below the threshold are set to zero. - else - rot = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e)) - absoluteMisorientation = rot%asQuaternion() - mySlipSystems: do s1 = 1,ns - neighborSlipSystems: do s2 = 1,ns - my_compatibility(1,s2,s1,n) = math_mul3x3(prm%slip_normal(1:3,s1), & - math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2))) & - * abs(math_mul3x3(prm%slip_direction(1:3,s1), & - math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2)))) - my_compatibility(2,s2,s1,n) = abs(math_mul3x3(prm%slip_normal(1:3,s1), & - math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2)))) & - * abs(math_mul3x3(prm%slip_direction(1:3,s1), & - math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2)))) - enddo neighborSlipSystems - my_compatibilitySum = 0.0_pReal - belowThreshold = .true. - do while (my_compatibilitySum < 1.0_pReal .and. any(belowThreshold(1:ns))) - thresholdValue = maxval(my_compatibility(2,1:ns,s1,n), belowThreshold(1:ns)) ! screws always positive - nThresholdValues = real(count(my_compatibility(2,1:ns,s1,n) >= thresholdValue),pReal) - where (my_compatibility(2,1:ns,s1,n) >= thresholdValue) & - belowThreshold(1:ns) = .false. - if (my_compatibilitySum + thresholdValue * nThresholdValues > 1.0_pReal) & - where (abs(my_compatibility(1:2,1:ns,s1,n)) >= thresholdValue) & ! MD: rather check below threshold? - my_compatibility(1:2,1:ns,s1,n) = sign((1.0_pReal - my_compatibilitySum) & - / nThresholdValues, my_compatibility(1:2,1:ns,s1,n)) - my_compatibilitySum = my_compatibilitySum + nThresholdValues * thresholdValue - enddo - where (belowThreshold(1:ns)) my_compatibility(1,1:ns,s1,n) = 0.0_pReal - where (belowThreshold(1:ns)) my_compatibility(2,1:ns,s1,n) = 0.0_pReal - enddo mySlipSystems - endif - -enddo neighbors - -compatibility(1:2,1:ns,1:ns,1:Nneighbors,i,e) = my_compatibility - -end associate + !* GRAIN BOUNDARY ! + !* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config) + + if (prm%grainboundaryTransmissivity >= 0.0_pReal) then + neighbor_textureID = material_texture(1,neighbor_i,neighbor_e) + if (neighbor_textureID /= textureID) then + if (.not. phase_localPlasticity(neighbor_phase)) then + forall(s1 = 1:ns) & + my_compatibility(1:2,s1,s1,n) = sqrt(prm%grainboundaryTransmissivity) + endif + cycle + endif + + + !* GRAIN BOUNDARY ? + !* Compatibility defined by relative orientation of slip systems: + !* The my_compatibility value is defined as the product of the slip normal projection and the slip direction projection. + !* Its sign is always positive for screws, for edges it has the same sign as the slip normal projection. + !* Since the sum for each slip system can easily exceed one (which would result in a transmissivity larger than one), + !* only values above or equal to a certain threshold value are considered. This threshold value is chosen, such that + !* the number of compatible slip systems is minimized with the sum of the original my_compatibility values exceeding one. + !* Finally the smallest my_compatibility value is decreased until the sum is exactly equal to one. + !* All values below the threshold are set to zero. + else + rot = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e)) + absoluteMisorientation = rot%asQuaternion() + mySlipSystems: do s1 = 1,ns + neighborSlipSystems: do s2 = 1,ns + my_compatibility(1,s2,s1,n) = math_mul3x3(prm%slip_normal(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2))) & + * abs(math_mul3x3(prm%slip_direction(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2)))) + my_compatibility(2,s2,s1,n) = abs(math_mul3x3(prm%slip_normal(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2)))) & + * abs(math_mul3x3(prm%slip_direction(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2)))) + enddo neighborSlipSystems + + my_compatibilitySum = 0.0_pReal + belowThreshold = .true. + do while (my_compatibilitySum < 1.0_pReal .and. any(belowThreshold(1:ns))) + thresholdValue = maxval(my_compatibility(2,1:ns,s1,n), belowThreshold(1:ns)) ! screws always positive + nThresholdValues = real(count(my_compatibility(2,1:ns,s1,n) >= thresholdValue),pReal) + where (my_compatibility(2,1:ns,s1,n) >= thresholdValue) & + belowThreshold(1:ns) = .false. + if (my_compatibilitySum + thresholdValue * nThresholdValues > 1.0_pReal) & + where (abs(my_compatibility(1:2,1:ns,s1,n)) >= thresholdValue) & ! MD: rather check below threshold? + my_compatibility(1:2,1:ns,s1,n) = sign((1.0_pReal - my_compatibilitySum) & + / nThresholdValues, my_compatibility(1:2,1:ns,s1,n)) + my_compatibilitySum = my_compatibilitySum + nThresholdValues * thresholdValue + enddo + where (belowThreshold(1:ns)) my_compatibility(1,1:ns,s1,n) = 0.0_pReal + where (belowThreshold(1:ns)) my_compatibility(2,1:ns,s1,n) = 0.0_pReal + enddo mySlipSystems + endif + + enddo neighbors + + compatibility(1:2,1:ns,1:ns,1:Nneighbors,i,e) = my_compatibility + + end associate end subroutine plastic_nonlocal_updateCompatibility !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) +function plastic_nonlocal_postResults(ph,instance,of) result(postResults) use prec, only: & dNeq0 use material, only: & - material_phase, & - phaseAt, phasememberAt, & - plasticState, & - phase_plasticityInstance + plasticState implicit none - real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress - integer, intent(in) :: & - ip, & !< integration point - el !< element + integer, intent(in) :: & + ph, & + instance, & + of - real(pReal), dimension(sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(material_phase(1,ip,el))))) :: & + real(pReal), dimension(sum(plastic_nonlocal_sizePostResult(:,instance))) :: & postResults integer :: & - ph, & - instance, & !< current instance of this plasticity ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation cs, & !< constitutive result index o, & !< index of current output - of,& !< offset shortcut t, & !< type of dislocation s !< index of my current slip system - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & + real(pReal), dimension(param(instance)%totalNslip,8) :: & rhoSgl, & rhoDotSgl !< evolution rate of single dislocation densities (positive/negative screw and edge without dipoles) - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + real(pReal), dimension(param(instance)%totalNslip,4) :: & gdot, & !< shear rates v !< velocities - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + real(pReal), dimension(param(instance)%totalNslip,2) :: & rhoDotDip !< evolution rate of dipole dislocation densities (screw and edge dipoles) -ph = phaseAt(1,ip,el) -of = phasememberAt(1,ip,el) -instance = phase_plasticityInstance(ph) -ns = totalNslip(instance) +ns = param(instance)%totalNslip cs = 0 -associate(prm => param(instance),dst => microstructure(instance),stt=>state(instance)) -!* short hand notations for state variables +associate(prm => param(instance),dst => microstructure(instance),stt=>state(instance),dot => dotState(instance)) forall (s = 1:ns, t = 1:4) rhoSgl(s,t+4) = plasticState(ph)%State(iRhoB(s,t,instance),of) From 6d268b7b3796e09db8a4e54c07f1a45f28ab9320 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 17:59:01 +0100 Subject: [PATCH 14/19] some polishing --- PRIVATE | 2 +- src/plastic_nonlocal.f90 | 48 +++++++++++++++++++++------------------- 2 files changed, 26 insertions(+), 24 deletions(-) diff --git a/PRIVATE b/PRIVATE index 3047f7af1..5272b99b7 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3047f7af15c3e77f0b2d9c19e9f581cf904b43ad +Subproject commit 5272b99b734600fbd1538b32fbcbbbb5e3dbcd30 diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 33c770f06..d0bcb9812 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -1469,7 +1469,6 @@ subroutine plastic_nonlocal_deltaState(Mp,ip,el) where(dNeq0(sqrt(sum(abs(rho(:,scr)),2)))) & dUpper(1:ns,2) = min(1.0_pReal/sqrt(sum(abs(rho(:,scr)),2)),dUpper(1:ns,2)) - dUpper = max(dUpper,prm%minDipoleHeight) deltaDUpper = dUpper - dUpperOld @@ -1691,16 +1690,16 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo - dLower = prm%minDipoleHeight(1:ns,1:2) + dLower = prm%minDipoleHeight dUpper(1:ns,1) = prm%mu * prm%burgers/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) dUpper(1:ns,2) = prm%mu * prm%burgers/(4.0_pReal * PI * abs(tau)) - do c = 1, 2 - where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& - +abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) & - dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & - + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & - dUpper(1:ns,c)) - enddo + + where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) & + dUpper(1:ns,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(1:ns,1)) + + where(dNeq0(sqrt(sum(abs(rho(:,scr)),2)))) & + dUpper(1:ns,2) = min(1.0_pReal/sqrt(sum(abs(rho(:,scr)),2)),dUpper(1:ns,2)) + dUpper = max(dUpper,dLower) !**************************************************************************** @@ -1826,12 +1825,12 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & * math_mul3x3(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility... rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) & - + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type - * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal + + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type + * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal where (compatibility(c,1:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility... rhoDotFlux(1:ns,topp) = rhoDotFlux(1:ns,topp) & - + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type - * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal + + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type + * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal endif enddo enddo @@ -1995,7 +1994,6 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & endif #endif plasticState(p)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) - return else forall (s = 1:ns, t = 1:4) plasticState(p)%dotState(iRhoU(s,t,instance),o) = rhoDot(s,t) @@ -2012,8 +2010,8 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & end subroutine plastic_nonlocal_dotState !-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!> @detail Compatibility is defined as normalized product of signed cosine of the angle between the slip +!> @brief Compatibility update +!> @detail Compatibility is defined as normalized product of signed cosine of the angle between the slip ! plane normals and signed cosine of the angle between the slip directions. Only the largest values ! that sum up to a total of 1 are considered, all others are set to zero. !-------------------------------------------------------------------------------------------------- @@ -2080,7 +2078,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal - !*** Loop thrugh neighbors and check whether there is any my_compatibility. + !*** Loop thrugh neighbors and check whether there is any compatibility. neighbors: do n = 1,Nneighbors neighbor_e = mesh_ipNeighborhood(1,n,i,e) @@ -2097,11 +2095,10 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) !* PHASE BOUNDARY - !* If we encounter a different nonlocal "cpfem" phase at the neighbor, + !* If we encounter a different nonlocal phase at the neighbor, !* we consider this to be a real "physical" phase boundary, so completely incompatible. - !* If one of the two "CPFEM" phases has a local plasticity law, + !* If one of the two phases has a local plasticity law, !* we do not consider this to be a phase boundary, so completely compatible. - neighbor_phase = material_phase(1,neighbor_i,neighbor_e) if (neighbor_phase /= ph) then if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph))& @@ -2112,7 +2109,6 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) !* GRAIN BOUNDARY ! !* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config) - if (prm%grainboundaryTransmissivity >= 0.0_pReal) then neighbor_textureID = material_texture(1,neighbor_i,neighbor_e) if (neighbor_textureID /= textureID) then @@ -2130,8 +2126,8 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) !* Its sign is always positive for screws, for edges it has the same sign as the slip normal projection. !* Since the sum for each slip system can easily exceed one (which would result in a transmissivity larger than one), !* only values above or equal to a certain threshold value are considered. This threshold value is chosen, such that - !* the number of compatible slip systems is minimized with the sum of the original my_compatibility values exceeding one. - !* Finally the smallest my_compatibility value is decreased until the sum is exactly equal to one. + !* the number of compatible slip systems is minimized with the sum of the original compatibility values exceeding one. + !* Finally the smallest compatibility value is decreased until the sum is exactly equal to one. !* All values below the threshold are set to zero. else rot = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e)) @@ -2171,6 +2167,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) compatibility(1:2,1:ns,1:ns,1:Nneighbors,i,e) = my_compatibility end associate + end subroutine plastic_nonlocal_updateCompatibility @@ -2379,6 +2376,10 @@ end associate end function plastic_nonlocal_postResults +!-------------------------------------------------------------------------------------------------- +!> @brief returns copy of current dislocation densities from state +!> @details raw values is rectified +!-------------------------------------------------------------------------------------------------- function getRho(instance,of,ip,el) use mesh @@ -2398,6 +2399,7 @@ function getRho(instance,of,ip,el) getRho = 0.0_pReal end associate + end function getRho From 66aa9399a7d2f5ba32d78397f2345d0a044c48d6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Mar 2019 18:06:41 +0100 Subject: [PATCH 15/19] don'r rely on halton sequence not really trustworthy as we saw some pattern for higher dimensional data --- src/math.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/math.f90 b/src/math.f90 index f77f81f8b..8c0020799 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1895,7 +1895,7 @@ real(pReal) function math_sampleGaussVar(meanvalue, stddev, width) myWidth = merge(width,3.0_pReal,present(width)) ! use +-3*sigma as default value for scatter if not given do - rnd = halton([6,2]) + call random_number(rnd) scatter = myWidth * (2.0_pReal * rnd(1) - 1.0_pReal) if (rnd(2) <= exp(-0.5_pReal * scatter ** 2.0_pReal)) exit ! test if scattered value is drawn enddo From da798ea69d4fb4f5525097103e55e5b4efa20899 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 19 Mar 2019 20:43:58 +0100 Subject: [PATCH 16/19] [skip ci] updated version information after successful test of v2.0.2-2111-g66aa9399 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 5f910380c..239d74ee9 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-2095-g19aa87ae +v2.0.2-2111-g66aa9399 From b6dff5373b53fdc0cacd53b978e2a9b186d86f11 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Mar 2019 21:22:21 +0100 Subject: [PATCH 17/19] PRIVATE with license for 2019 --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 5272b99b7..d81a446bd 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 5272b99b734600fbd1538b32fbcbbbb5e3dbcd30 +Subproject commit d81a446bdfaa2bc3c939e802c50a5fd8f2fb38e3 From 6d1367e85a13452f49919dca9bbf4d9ae7de38ec Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Mar 2019 23:54:28 +0100 Subject: [PATCH 18/19] patch for release --- installation/patch/README.md | 4 +-- installation/patch/disable_HDF5 | 57 +++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+), 2 deletions(-) create mode 100644 installation/patch/disable_HDF5 diff --git a/installation/patch/README.md b/installation/patch/README.md index e1f0c6d72..dd8232758 100644 --- a/installation/patch/README.md +++ b/installation/patch/README.md @@ -11,8 +11,8 @@ patch -p1 < installation/patch/nameOfPatch ## Available patches - * **fwbw_derivative** switches the default spatial derivative from continuous to forward/backward difference. - This generally reduces spurious oscillations in the result as the spatial accuracy of the derivative is then compatible with the underlying solution grid. + * **disable_HDF5** disables all HDF5 output. + HDF5 output is an experimental feature. Also, some routines not present in HDF5 1.8.x are remove to allow compilation of DAMASK with HDF5 < 1.10.x ## Create patch commit your changes diff --git a/installation/patch/disable_HDF5 b/installation/patch/disable_HDF5 new file mode 100644 index 000000000..bbba30c4a --- /dev/null +++ b/installation/patch/disable_HDF5 @@ -0,0 +1,57 @@ +diff --git a/src/DAMASK_grid.f90 b/src/DAMASK_grid.f90 +index 496bfd0d..7b0f499c 100644 +--- a/src/DAMASK_grid.f90 ++++ b/src/DAMASK_grid.f90 +@@ -75,7 +75,6 @@ program DAMASK_spectral + use grid_mech_spectral_polarisation + use grid_damage_spectral + use grid_thermal_spectral +- use results + + implicit none + +@@ -153,8 +152,6 @@ program DAMASK_spectral + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019' + write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80' + +- call results_openJobFile() +- call results_closeJobFile() + !-------------------------------------------------------------------------------------------------- + ! initialize field solver information + nActiveFields = 1 +@@ -595,7 +592,6 @@ program DAMASK_spectral + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') + enddo + fileOffset = fileOffset + sum(outputSize) ! forward to current file position +- call CPFEM_results(totalIncsCounter,time) + endif + if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... + .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information +diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 +index a81aaee0..3d3cdee3 100644 +--- a/src/HDF5_utilities.f90 ++++ b/src/HDF5_utilities.f90 +@@ -197,7 +197,6 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName) + !------------------------------------------------------------------------------------------------- + ! setting I/O mode to collective + #ifdef PETSc +- call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') + #endif + +@@ -232,7 +231,6 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName) + !------------------------------------------------------------------------------------------------- + ! setting I/O mode to collective + #ifdef PETSc +- call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') + #endif + +@@ -1646,7 +1644,6 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f') + #ifdef PETSc +- call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f') + #endif + From 103542be0ba60f9b509a802d0411e93f344d5496 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 21 Mar 2019 00:42:09 +0100 Subject: [PATCH 19/19] [skip ci] updated version information after successful test of v2.0.2-2113-gb6dff537 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 239d74ee9..53d4b21e4 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-2111-g66aa9399 +v2.0.2-2113-gb6dff537