diff --git a/PRIVATE b/PRIVATE index 683bf0074..beb9682ff 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 683bf0074f3fa079989b51f5a67aa593b7577f0b +Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b diff --git a/VERSION b/VERSION index 8da7b3148..3801ac74e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1453-g8e56f0d0 +v2.0.2-1540-ge2582a8d diff --git a/src/IO.f90 b/src/IO.f90 index 193580fcc..1f9ff937c 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1236,6 +1236,10 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'zero entry on stiffness diagonal' case (136_pInt) msg = 'zero entry on stiffness diagonal for transformed phase' + case (137_pInt) + msg = 'not defined for lattice structure' + case (138_pInt) + msg = 'not enough interaction parameters given' !-------------------------------------------------------------------------------------------------- ! errors related to the parsing of material.config diff --git a/src/config.f90 b/src/config.f90 index b79442e62..b184f2a6b 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -550,7 +550,7 @@ end function getString !> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- -function getFloats(this,key,defaultVal,requiredShape,requiredSize) +function getFloats(this,key,defaultVal,requiredSize) use IO, only: & IO_error, & IO_stringValue, & @@ -561,7 +561,6 @@ function getFloats(this,key,defaultVal,requiredShape,requiredSize) class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key real(pReal), dimension(:), intent(in), optional :: defaultVal - integer(pInt), dimension(:), intent(in), optional :: requiredShape ! not useful (is always 1D array) integer(pInt), intent(in), optional :: requiredSize type(tPartitionedStringList), pointer :: item integer(pInt) :: i @@ -601,7 +600,7 @@ end function getFloats !> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- -function getInts(this,key,defaultVal,requiredShape,requiredSize) +function getInts(this,key,defaultVal,requiredSize) use IO, only: & IO_error, & IO_stringValue, & @@ -611,8 +610,7 @@ function getInts(this,key,defaultVal,requiredShape,requiredSize) integer(pInt), dimension(:), allocatable :: getInts class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key - integer(pInt), dimension(:), intent(in), optional :: defaultVal, & - requiredShape ! not useful (is always 1D array) + integer(pInt), dimension(:), intent(in), optional :: defaultVal integer(pInt), intent(in), optional :: requiredSize type(tPartitionedStringList), pointer :: item integer(pInt) :: i @@ -653,7 +651,7 @@ end function getInts !! values from the last occurrence. If key is not found exits with error unless default is given. !! If raw is true, the the complete string is returned, otherwise the individual chunks are returned !-------------------------------------------------------------------------------------------------- -function getStrings(this,key,defaultVal,requiredShape,raw) +function getStrings(this,key,defaultVal,raw) use IO, only: & IO_error, & IO_StringValue @@ -663,7 +661,6 @@ function getStrings(this,key,defaultVal,requiredShape,raw) class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key character(len=65536),dimension(:), intent(in), optional :: defaultVal - integer(pInt), dimension(:), intent(in), optional :: requiredShape logical, intent(in), optional :: raw type(tPartitionedStringList), pointer :: item character(len=65536) :: str diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ccaf01c33..a0d7147a6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -151,7 +151,7 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init - if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then call plastic_nonlocal_init(FILEUNIT) @@ -365,7 +365,7 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) use plastic_nonlocal, only: & plastic_nonlocal_microstructure use plastic_dislotwin, only: & - plastic_dislotwin_microstructure + plastic_dislotwin_dependentState use plastic_disloUCLA, only: & plastic_disloUCLA_dependentState @@ -389,7 +389,9 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_microstructure(temperature(ho)%p(tme),ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) @@ -409,9 +411,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e pReal use math, only: & math_mul33x33, & - math_Mandel6to33, & - math_Mandel33to6, & - math_Plain99to3333 + math_6toSym33, & + math_sym33to6, & + math_99to3333 use material, only: & phasememberAt, & phase_plasticity, & @@ -470,7 +472,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) - S = math_Mandel6to33(S6) + S = math_6toSym33(S6) Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -495,9 +497,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp), & + call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_sym33to6(Mp), & temperature(ho)%p(tme),ip,el) - dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget + dLp_dMp = math_99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget case (PLASTICITY_DISLOTWIN_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -540,7 +542,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e math_inv33, & math_det33, & math_mul33x33, & - math_Mandel6to33 + math_6toSym33 use material, only: & phasememberAt, & phase_plasticity, & @@ -597,7 +599,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e case (PLASTICITY_isotropic_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_Mandel6to33(S6),instance,of) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6),instance,of) case default plasticityType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -716,7 +718,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip use math, only : & math_mul33x33, & math_mul3333xx33, & - math_Mandel66to3333, & + math_66toSym3333, & math_I3 use material, only: & material_phase, & @@ -749,7 +751,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip i, j ho = material_homogenizationAt(el) - C = math_Mandel66to3333(constitutive_homogenizedC(ipc,ip,el)) + C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el)) DegradationLoop: do d = 1_pInt, phase_NstiffnessDegradations(material_phase(ipc,ip,el)) degradationType: select case(phase_stiffnessDegradation(d,material_phase(ipc,ip,el))) @@ -784,8 +786,8 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac debug_levelBasic use math, only: & math_mul33x33, & - math_Mandel6to33, & - math_Mandel33to6, & + math_6toSym33, & + math_sym33to6, & math_mul33x33 use mesh, only: & mesh_NcpElems, & @@ -854,13 +856,13 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position - s, & !< counter in source loop + s, & !< counter in source loop instance, of ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6)) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -890,7 +892,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState (math_Mandel33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), & + call plastic_nonlocal_dotState (math_sym33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), & subdt,subfracArray,ip,el) end select plasticityType @@ -920,7 +922,7 @@ end subroutine constitutive_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) +subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) use prec, only: & pReal, & pLongInt @@ -929,8 +931,7 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) debug_constitutive, & debug_levelBasic use math, only: & - math_Mandel6to33, & - math_Mandel33to6, & + math_sym33to6, & math_mul33x33 use material, only: & phasememberAt, & @@ -954,18 +955,17 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(6) :: & - S6 !< 2nd Piola Kirchhoff stress (vector notation) real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola Kirchhoff stress Fe, & !< elastic deformation gradient Fi !< intermediate deformation gradient real(pReal), dimension(3,3) :: & Mp integer(pInt) :: & - s, & !< counter in source loop + i, & instance, of - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -975,13 +975,13 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) call plastic_kinehardening_deltaState(Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(math_Mandel33to6(Mp),ip,el) + call plastic_nonlocal_deltaState(math_sym33to6(Mp),ip,el) end select plasticityType - sourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) + sourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) - sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) + sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) case (SOURCE_damage_isoBrittle_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & @@ -1001,7 +1001,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) use prec, only: & pReal use math, only: & - math_Mandel6to33, & + math_6toSym33, & math_mul33x33 use mesh, only: & mesh_NcpElems, & @@ -1076,7 +1076,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) constitutive_postResults = 0.0_pReal - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6)) ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 1fcd92705..af69b1727 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1654,29 +1654,7 @@ subroutine integrateStateFPI() !$OMP END PARALLEL DO call update_dependentState - !$OMP PARALLEL - - ! --- STRESS INTEGRATION --- - -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo before stress integration' -#endif - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ... then all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO -!$OMP END PARALLEL + call update_stress(1.0_pReal) call update_dotState(1.0_pReal) !$OMP PARALLEL ! --- UPDATE STATE --- @@ -1874,17 +1852,6 @@ end subroutine integrateStateFPI subroutine integrateStateEuler() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use mesh, only: & mesh_element, & mesh_NcpElems @@ -1896,7 +1863,6 @@ subroutine integrateStateEuler() constitutive_microstructure implicit none - integer(pInt) :: & e, & ! element index in element loop i, & ! integration point index in ip loop @@ -1921,63 +1887,10 @@ eIter = FEsolving_execElem(1:2) call update_dotState(1.0_pReal) call update_State(1.0_pReal) - - !$OMP PARALLEL - - - - - ! --- STATE JUMP --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP END PARALLEL - - call update_dependentState - - - !$OMP PARALLEL - ! --- STRESS INTEGRATION --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - - ! --- SET CONVERGENCE FLAG --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definitionem - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP END PARALLEL - + call update_deltaState + call update_dependentState + call update_stress(1.0_pReal) + call setConvergenceFlag ! --- CHECK NON-LOCAL CONVERGENCE --- @@ -2109,74 +2022,13 @@ subroutine integrateStateAdaptiveEuler() endif enddo; enddo; enddo !$OMP ENDDO - - - ! --- STATE JUMP --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO !$OMP END PARALLEL - + call update_deltaState call update_dependentState - - - ! --- STRESS INTEGRATION (EULER INTEGRATION) --- - - !$OMP PARALLEL DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP END PARALLEL DO - - - call update_dotState(1.0_pReal) + call update_stress(1.0_pReal) + call update_dotState(1.0_pReal) !$OMP PARALLEL - !$OMP DO PRIVATE(p,c,NaN) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) - NaN = any(IEEE_is_NaN(plasticState(p)%dotState(:,c))) - do mySource = 1_pInt, phase_Nsources(p) - NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%dotState(:,c))) - enddo - if (NaN) then ! NaN occured in any dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - ! --- ERROR ESTIMATE FOR STATE (HEUN METHOD) --- !$OMP SINGLE @@ -2365,46 +2217,9 @@ subroutine integrateStateRK4() !$OMP END PARALLEL call update_state(TIMESTEPFRACTION(n)) - - !$OMP PARALLEL - ! --- state jump --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + call update_deltaState call update_dependentState - !$OMP PARALLEL - - - ! --- stress integration --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e,timeStepFraction(n)) ! fraction of original times step - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO -!$OMP END PARALLEL + call update_stress(TIMESTEPFRACTION(n)) ! --- dot state and RK dot state--- @@ -2414,14 +2229,7 @@ subroutine integrateStateRK4() enddo - - - ! --- SET CONVERGENCE FLAG --- - - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definitionem - enddo; enddo; enddo - + call setConvergenceFlag ! --- CHECK NONLOCAL CONVERGENCE --- @@ -2584,51 +2392,10 @@ subroutine integrateStateRKCK45() !$OMP END PARALLEL call update_state(1.0_pReal) !MD: 1.0 correct? - - !$OMP PARALLEL - - - ! --- state jump --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL - - - - call update_dependentState - !$OMP PARALLEL - - ! --- stress integration --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e,C(stage)) ! fraction of original time step - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL - call update_dotState(C(stage)) + call update_deltaState + call update_dependentState + call update_stress(C(stage)) + call update_dotState(C(stage)) enddo @@ -2735,56 +2502,12 @@ subroutine integrateStateRKCK45() endif enddo; enddo; enddo !$OMP ENDDO +!$OMP END PARALLEL - - ! --- STATE JUMP --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL - + call update_deltaState call update_dependentState - - !$OMP PARALLEL -!-------------------------------------------------------------------------------------------------- -! --- FINAL STRESS INTEGRATION STEP IF RESIDUUM BELOW TOLERANCE --- - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - -!-------------------------------------------------------------------------------------------------- -! --- SET CONVERGENCE FLAG --- - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definition - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP END PARALLEL + call update_stress(1.0_pReal) + call setConvergenceFlag ! --- nonlocal convergence check --- @@ -2798,6 +2521,67 @@ subroutine integrateStateRKCK45() end subroutine integrateStateRKCK45 +!-------------------------------------------------------------------------------------------------- +!> @brief Sets convergence flag based on "todo": every point that survived the integration (todo is +! still .true. is considered as converged +!> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria +!-------------------------------------------------------------------------------------------------- +subroutine setConvergenceFlag() + + implicit none + integer(pInt) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + + !OMP DO PARALLEL PRIVATE(i,g) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + g = 1:homogenization_Ngrains(mesh_element(3,e))) + crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definition + end forall; enddo + !OMP END DO PARALLEL + +end subroutine setConvergenceFlag + + +!-------------------------------------------------------------------------------------------------- +!> @brief Standard forwarding of state as state = state0 + dotState * (delta t) +!-------------------------------------------------------------------------------------------------- +subroutine update_stress(timeFraction) + use material, only: & + plasticState, & + sourceState, & + phase_Nsources, & + phaseAt, phasememberAt + + implicit none + real(pReal), intent(in) :: & + timeFraction + integer(pInt) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g + + !$OMP PARALLEL DO + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + !$OMP FLUSH(crystallite_todo) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + crystallite_todo(g,i,e) = integrateStress(g,i,e,timeFraction) + !$OMP FLUSH(crystallite_todo) + if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... + !$OMP CRITICAL (checkTodo) + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped + !$OMP END CRITICAL (checkTodo) + endif + endif + enddo; enddo; enddo + !$OMP END PARALLEL DO + +end subroutine update_stress + !-------------------------------------------------------------------------------------------------- !> @brief tbd !-------------------------------------------------------------------------------------------------- @@ -2824,6 +2608,7 @@ subroutine update_dependentState() end subroutine update_dependentState + !-------------------------------------------------------------------------------------------------- !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- @@ -2886,7 +2671,6 @@ subroutine update_dotState(timeFraction) constitutive_collectDotState implicit none - real(pReal), intent(in) :: & timeFraction integer(pInt) :: & @@ -2897,15 +2681,17 @@ subroutine update_dotState(timeFraction) c, & s logical :: & - NaN + NaN, & + nonlocalStop + + nonlocalStop = .false. - !$OMP PARALLEL - !$OMP DO PRIVATE (p,c,NaN) + !$OMP PARALLEL DO PRIVATE (p,c,NaN) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + !$OMP FLUSH(nonlocalStop) + if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe, & crystallite_Fi(1:3,1:3,g,i,e), & @@ -2918,20 +2704,94 @@ subroutine update_dotState(timeFraction) enddo if (NaN) then crystallite_todo(g,i,e) = .false. ! this one done (and broken) - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken is a local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals done (and broken) - !$OMP END CRITICAL (checkTodo) - endif + if (.not. crystallite_localPlasticity(g,i,e)) nonlocalStop = .True. endif endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO + + if (nonlocalStop) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity end subroutine update_DotState +subroutine update_deltaState + use, intrinsic :: & + IEEE_arithmetic + use prec, only: & + dNeq0 + use material, only: & + plasticState, & + sourceState, & + phase_Nsources, & + phaseAt, phasememberAt + use constitutive, only: & + constitutive_collectDeltaState + use math, only: & + math_6toSym33 + implicit none + integer(pInt) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g, & !< grain index in grain loop + p, & + mySize, & + myOffset, & + mySource, & + c, & + s + logical :: & + NaN, & + nonlocalStop + + nonlocalStop = .false. + + !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,mySource,NaN) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + !$OMP FLUSH(nonlocalStop) + if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then + call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & + crystallite_Fe(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e), & + g,i,e) + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + myOffset = plasticState(p)%offsetDeltaState + mySize = plasticState(p)%sizeDeltaState + NaN = any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySize,c))) + + if (.not. NaN) then + + plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) = & + plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) + & + plasticState(p)%deltaState(1:mySize,c) + do mySource = 1_pInt, phase_Nsources(p) + myOffset = sourceState(p)%p(mySource)%offsetDeltaState + mySize = sourceState(p)%p(mySource)%sizeDeltaState + NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySize,c))) + + if (.not. NaN) then + sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) = & + sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) + & + sourceState(p)%p(mySource)%deltaState(1:mySize,c) + endif + enddo + endif + + crystallite_todo(g,i,e) = .not. NaN + if (.not. crystallite_todo(g,i,e)) then ! if state jump fails, then convergence is broken + crystallite_converged(g,i,e) = .false. + if (.not. crystallite_localPlasticity(g,i,e)) nonlocalStop = .true. + endif + endif + enddo; enddo; enddo + !$OMP END PARALLEL DO + if (nonlocalStop) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity + +end subroutine update_deltaState + + !-------------------------------------------------------------------------------------------------- !> @brief calculates a jump in the state according to the current state and the current stress !> returns true, if state jump was successfull or not needed. false indicates NaN in delta state @@ -2958,6 +2818,8 @@ logical function stateJump(ipc,ip,el) phaseAt, phasememberAt use constitutive, only: & constitutive_collectDeltaState + use math, only: & + math_6toSym33 implicit none integer(pInt), intent(in):: & @@ -2969,57 +2831,50 @@ logical function stateJump(ipc,ip,el) c, & p, & mySource, & - myOffsetPlasticDeltaState, & - myOffsetSourceDeltaState, & - mySizePlasticDeltaState, & - mySizeSourceDeltaState + myOffset, & + mySize c = phasememberAt(ipc,ip,el) p = phaseAt(ipc,ip,el) - call constitutive_collectDeltaState(crystallite_Tstar_v(1:6,ipc,ip,el), & + call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)), & crystallite_Fe(1:3,1:3,ipc,ip,el), & crystallite_Fi(1:3,1:3,ipc,ip,el), & ipc,ip,el) - myOffsetPlasticDeltaState = plasticState(p)%offsetDeltaState - mySizePlasticDeltaState = plasticState(p)%sizeDeltaState + myOffset = plasticState(p)%offsetDeltaState + mySize = plasticState(p)%sizeDeltaState - if( any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c)))) then ! NaN occured in deltaState + if( any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySize,c)))) then ! NaN occured in deltaState stateJump = .false. return endif - plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & - myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) = & - plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & - myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) + & - plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) + plasticState(p)%state(myOffset + 1_pInt:myOffset + mySize,c) = & + plasticState(p)%state(myOffset + 1_pInt:myOffset + mySize,c) + plasticState(p)%deltaState(1:mySize,c) do mySource = 1_pInt, phase_Nsources(p) - myOffsetSourceDeltaState = sourceState(p)%p(mySource)%offsetDeltaState - mySizeSourceDeltaState = sourceState(p)%p(mySource)%sizeDeltaState - if (any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c)))) then ! NaN occured in deltaState + myOffset = sourceState(p)%p(mySource)%offsetDeltaState + mySize = sourceState(p)%p(mySource)%sizeDeltaState + if (any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySize,c)))) then ! NaN occured in deltaState stateJump = .false. return endif - sourceState(p)%p(mySource)%state(myOffsetSourceDeltaState + 1_pInt : & - myOffsetSourceDeltaState + mySizeSourceDeltaState,c) = & - sourceState(p)%p(mySource)%state(myOffsetSourceDeltaState + 1_pInt : & - myOffsetSourceDeltaState + mySizeSourceDeltaState,c) + & - sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c) + sourceState(p)%p(mySource)%state(myOffset + 1_pInt: myOffset + mySize,c) = & + sourceState(p)%p(mySource)%state(myOffset + 1_pInt: myOffset + mySize,c) + & + sourceState(p)%p(mySource)%deltaState(1:mySize,c) enddo #ifdef DEBUG - if (any(dNeq0(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c))) & + if (any(dNeq0(plasticState(p)%deltaState(1:mySize,c))) & .and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then write(6,'(a,i8,1x,i2,1x,i3, /)') '<< CRYST >> update state at el ip ipc ',el,ip,ipc - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> deltaState', plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> deltaState', plasticState(p)%deltaState(1:mySize,c) write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', & - plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & - myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) + plasticState(p)%state(myOffset + 1_pInt : & + myOffset + mySize,c) endif #endif diff --git a/src/lattice.f90 b/src/lattice.f90 index 2b2a5641d..9be30a5d3 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -3,8 +3,8 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief defines lattice structure definitions, slip and twin system definitions, Schimd matrix -!> calculation and non-Schmid behavior +!> @brief contains lattice structure definitions including Schmid matrices for slip, twin, trans, +! and cleavage as well as interaction among the various systems !-------------------------------------------------------------------------------------------------- module lattice use prec, only: & @@ -13,27 +13,18 @@ module lattice implicit none private + ! BEGIN DEPRECATED integer(pInt), parameter, public :: & LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures - LATTICE_maxNtwinFamily = 4_pInt, & !< max # of twin system families over lattice structures - LATTICE_maxNtransFamily = 1_pInt, & !< max # of transformation system families over lattice structures LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures integer(pInt), allocatable, dimension(:,:), protected, public :: & lattice_NslipSystem, & !< total # of slip systems in each family - lattice_NtwinSystem, & !< total # of twin systems in each family - lattice_NtransSystem, & !< total # of transformation systems in each family lattice_NcleavageSystem !< total # of transformation systems in each family integer(pInt), allocatable, dimension(:,:,:), protected, public :: & - lattice_interactionSlipSlip, & !< Slip--slip interaction type - lattice_interactionSlipTwin, & !< Slip--twin interaction type - lattice_interactionTwinSlip, & !< Twin--slip interaction type - lattice_interactionTwinTwin, & !< Twin--twin interaction type - lattice_interactionSlipTrans, & !< Slip--trans interaction type - lattice_interactionTransSlip, & !< Trans--slip interaction type - lattice_interactionTransTrans !< Trans--trans interaction type + lattice_interactionSlipSlip !< Slip--slip interaction type real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & lattice_Sslip, & !< Schmid and non-Schmid matrices @@ -41,57 +32,40 @@ module lattice real(pReal), allocatable, dimension(:,:,:,:), protected, public :: & lattice_Sslip_v, & !< Mandel notation of lattice_Sslip - lattice_Scleavage_v, & !< Mandel notation of lattice_Scleavege - lattice_Qtrans, & !< Total rotation: Q = R*B - lattice_Strans, & !< Eigendeformation tensor for phase transformation - lattice_Stwin, & - lattice_Qtwin + lattice_Scleavage_v !< Mandel notation of lattice_Scleavege real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_sn, & !< normal direction of slip system lattice_st, & !< sd x sn - lattice_sd, & !< slip direction of slip system - lattice_Stwin_v, & - lattice_Strans_v, & !< Eigendeformation tensor in vector form - lattice_projectionTrans !< Matrix for projection of slip to fault-band (twin) systems for strain-induced martensite nucleation - - real(pReal), allocatable, dimension(:,:), protected, public :: & - lattice_shearTwin, & !< characteristic twin shear - lattice_shearTrans !< characteristic transformation shear + lattice_sd !< slip direction of slip system integer(pInt), allocatable, dimension(:), protected, public :: & lattice_NnonSchmid !< total # of non-Schmid contributions for each structure - - real(pReal), allocatable, dimension(:,:,:), private :: & - lattice_tn, & - lattice_td, & - lattice_tt ! END DEPRECATED !-------------------------------------------------------------------------------------------------- ! face centered cubic integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_fcc_NslipSystem = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc + LATTICE_FCC_NSLIPSYSTEM = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) !< # of twin systems per family for fcc + integer(pInt), dimension(1), parameter, public :: & + LATTICE_FCC_NTWINSYSTEM = int([12],pInt) !< # of twin systems per family for fcc - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_fcc_NtransSystem = int([12],pInt) !< # of transformation systems per family for fcc + integer(pInt), dimension(1), parameter, public :: & + LATTICE_FCC_NTRANSSYSTEM = int([12],pInt) !< # of transformation systems per family for fcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc + LATTICE_FCC_NCLEAVAGESYSTEM = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & - LATTICE_fcc_Nslip = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc - LATTICE_fcc_Ntwin = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc - LATTICE_fcc_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for fcc - LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc - LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc + LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc + LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc + LATTICE_FCC_NTRANS = sum(LATTICE_FCC_NTRANSSYSTEM), & !< total # of transformation systems for fcc + LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc - real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: & - LATTICE_fcc_systemSlip = reshape(real([& + real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & + LATTICE_FCC_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! SCHMID-BOAS notation 0, 1,-1, 1, 1, 1, & ! B2 -1, 0, 1, 1, 1, 1, & ! B4 @@ -118,7 +92,7 @@ module lattice ['<0 1 -1>{1 1 1}', & '<0 1 -1>{0 1 1}'] - real(pReal), dimension(3+3,LATTICE_fcc_Ntwin), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: & LATTICE_fcc_systemTwin = reshape(real( [& -2, 1, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, & @@ -132,32 +106,14 @@ module lattice 2, 1,-1, -1, 1,-1, & -1,-2,-1, -1, 1,-1, & -1, 1, 2, -1, 1,-1 & - ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli + ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = & ['<-2 1 1>{1 1 1}'] - real(pReal), dimension(3+3,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTohex_systemTrans = reshape(real( [& - -2, 1, 1, 1, 1, 1, & - 1,-2, 1, 1, 1, 1, & - 1, 1,-2, 1, 1, 1, & - 2,-1, 1, -1,-1, 1, & - -1, 2, 1, -1,-1, 1, & - -1,-1,-2, -1,-1, 1, & - -2,-1,-1, 1,-1,-1, & - 1, 2,-1, 1,-1,-1, & - 1,-1, 2, 1,-1,-1, & - 2, 1,-1, -1, 1,-1, & - -1,-2,-1, -1, 1,-1, & - -1, 1, 2, -1, 1,-1 & - ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) - real(pReal), dimension(LATTICE_fcc_Ntwin), parameter, private :: & - LATTICE_fcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) !< Twin system <112>{111} ??? Sorted according to Eisenlohr & Hantcherli - - integer(pInt), dimension(2_pInt,LATTICE_fcc_Ntwin), parameter, public :: & - LATTICE_fcc_twinNucleationSlipPair = reshape(int( [& + integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, public :: & + LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape(int( [& 2,3, & 1,3, & 1,2, & @@ -172,8 +128,9 @@ module lattice 10,11 & ],pInt),shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) - integer(pInt), dimension(LATTICE_fcc_Nslip,lattice_fcc_Nslip), parameter, public :: & - LATTICE_fcc_interactionSlipSlip = reshape(int( [& +! ToDo: should be in the interaction function + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter, public :: & + LATTICE_FCC_INTERACTIONSLIPSLIP = reshape(int( [& 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & ! ---> slip 2, 1, 2, 6, 4, 5, 5, 4, 6, 5, 3, 5, 9,10,11,12, 9,10, & ! | 2, 2, 1, 5, 5, 3, 5, 6, 4, 6, 5, 4, 11,12, 9,10, 9,10, & ! | @@ -186,14 +143,14 @@ module lattice 4, 5, 6, 3, 5, 5, 4, 6, 5, 1, 2, 2, 10, 9, 9,10,12,11, & 5, 3, 5, 5, 4, 6, 6, 4, 5, 2, 1, 2, 10, 9,11,12,10, 9, & 6, 5, 4, 5, 6, 4, 5, 5, 3, 2, 2, 1, 12,11, 9,10,10, 9, & - - 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & - 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & - 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & - 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & - 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & - 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & - ],pInt),[LATTICE_fcc_Nslip,LATTICE_fcc_Nslip],order=[2,1]) !< Slip--slip interaction types for fcc + + 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & + 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & + 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & + 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & + 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & + 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & + ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for fcc !< 1: self interaction !< 2: coplanar interaction !< 3: collinear interaction @@ -206,180 +163,6 @@ module lattice !<10: similar to glissile junctions in <110>{111} btw one {110} and one {111} plane !<11: crossing btw one {110} and one {111} plane !<12: collinear btw one {110} and one {111} plane - integer(pInt), dimension(LATTICE_fcc_Nslip,LATTICE_fcc_Ntwin), parameter, public :: & - LATTICE_fcc_interactionSlipTwin = reshape(int( [& - 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> twin - 1,1,1,3,3,3,3,3,3,2,2,2, & ! | - 1,1,1,2,2,2,3,3,3,3,3,3, & ! | - 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip - 3,3,3,1,1,1,2,2,2,3,3,3, & - 2,2,2,1,1,1,3,3,3,3,3,3, & - 2,2,2,3,3,3,1,1,1,3,3,3, & - 3,3,3,2,2,2,1,1,1,3,3,3, & - 3,3,3,3,3,3,1,1,1,2,2,2, & - 3,3,3,2,2,2,3,3,3,1,1,1, & - 2,2,2,3,3,3,3,3,3,1,1,1, & - 3,3,3,3,3,3,2,2,2,1,1,1, & - - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4 & - ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for fcc - !< 1: coplanar interaction - !< 2: screw trace between slip system and twin habit plane (easy cross slip) - !< 3: other interaction - integer(pInt), dimension(LATTICE_fcc_Ntwin,LATTICE_fcc_Nslip), parameter, public :: & - LATTICE_fcc_interactionTwinSlip = 1_pInt !< Twin--Slip interaction types for fcc - - integer(pInt), dimension(LATTICE_fcc_Ntwin,LATTICE_fcc_Ntwin), parameter,public :: & - LATTICE_fcc_interactionTwinTwin = reshape(int( [& - 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> twin - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 2,2,2,1,1,1,2,2,2,2,2,2, & ! v twin - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1 & - ],pInt),shape(LATTICE_FCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for fcc - - integer(pInt), dimension(LATTICE_fcc_Nslip,LATTICE_fcc_Ntrans), parameter, public :: & - LATTICE_fccTohex_interactionSlipTrans = reshape(int( [& - 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> trans - 1,1,1,3,3,3,3,3,3,2,2,2, & ! | - 1,1,1,2,2,2,3,3,3,3,3,3, & ! | - 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip - 3,3,3,1,1,1,2,2,2,3,3,3, & - 2,2,2,1,1,1,3,3,3,3,3,3, & - 2,2,2,3,3,3,1,1,1,3,3,3, & - 3,3,3,2,2,2,1,1,1,3,3,3, & - 3,3,3,3,3,3,1,1,1,2,2,2, & - 3,3,3,2,2,2,3,3,3,1,1,1, & - 2,2,2,3,3,3,3,3,3,1,1,1, & - 3,3,3,3,3,3,2,2,2,1,1,1, & - - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4 & - ],pInt),shape(LATTICE_FCCTOHEX_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip--trans interaction types for fcc - - integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Nslip), parameter, public :: & - LATTICE_fccTohex_interactionTransSlip = 1_pInt !< Trans--Slip interaction types for fcc - - integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Ntrans), parameter,public :: & - LATTICE_fccTohex_interactionTransTrans = reshape(int( [& - 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> trans - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 2,2,2,1,1,1,2,2,2,2,2,2, & ! v trans - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1 & - ],pInt),shape(LATTICE_FCCTOHEX_INTERACTIONTRANSTRANS),order=[2,1]) !< Trans--trans interaction types for fcc - - real(pReal), dimension(LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTohex_shearTrans = sqrt(1.0_pReal/8.0_pReal) - - real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTobcc_systemTrans = reshape([& - 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) - 0.0, 1.0, 0.0, -10.26, & - 0.0, 0.0, 1.0, 10.26, & - 0.0, 0.0, 1.0, -10.26, & - 1.0, 0.0, 0.0, 10.26, & - 1.0, 0.0, 0.0, -10.26, & - 0.0, 0.0, 1.0, 10.26, & - 0.0, 0.0, 1.0, -10.26, & - 1.0, 0.0, 0.0, 10.26, & - 1.0, 0.0, 0.0, -10.26, & - 0.0, 1.0, 0.0, 10.26, & - 0.0, 1.0, 0.0, -10.26 & - ],shape(LATTICE_FCCTOBCC_SYSTEMTRANS)) - - integer(pInt), dimension(9,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTobcc_bainVariant = reshape(int( [& - 1, 0, 0, 0, 1, 0, 0, 0, 1, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0 & - ],pInt),shape(LATTICE_FCCTOBCC_BAINVARIANT)) - - real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTobcc_bainRot = reshape([& - 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant - 1.0, 0.0, 0.0, 45.0, & - 1.0, 0.0, 0.0, 45.0, & - 1.0, 0.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0 & - ],shape(LATTICE_FCCTOBCC_BAINROT)) - - real(pReal), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Ntrans), parameter, private :: & ! Matrix for projection of shear from slip system to fault-band (twin) systems - LATTICE_fccTobcc_projectionTrans = reshape(real([& ! For ns = nt = nr - 0, 1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - -1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 1,-1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, -1, 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1,-1, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 1,-1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, -1, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 1,-1, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,-1, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0, 1, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,-1, 0 & - ],pReal),shape(LATTICE_FCCTOBCC_PROJECTIONTRANS),order=[2,1]) - - real(pReal), parameter, private :: & - LATTICE_fccTobcc_projectionTransFactor = sqrt(3.0_pReal/4.0_pReal) - - real(pReal), parameter, public :: & - LATTICE_fccTobcc_shearCritTrans = 0.0224 - - integer(pInt), dimension(2_pInt,LATTICE_fcc_Ntrans), parameter, public :: & - LATTICE_fccTobcc_transNucleationTwinPair = reshape(int( [& - 4, 7, & - 1, 10, & - 1, 4, & - 7, 10, & - 2, 8, & - 5, 11, & - 8, 11, & - 2, 5, & - 6, 12, & - 3, 9, & - 3, 12, & - 6, 9 & - ],pInt),shape(LATTICE_FCCTOBCC_TRANSNUCLEATIONTWINPAIR)) real(pReal), dimension(3+3,LATTICE_fcc_Ncleavage), parameter, private :: & LATTICE_fcc_systemCleavage = reshape(real([& @@ -396,25 +179,21 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered cubic integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_bcc_NslipSystem = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc + LATTICE_BCC_NSLIPSYSTEM = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) !< # of twin systems per family for bcc - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bcc_NtransSystem = int([0],pInt) !< # of transformation systems per family for bcc + integer(pInt), dimension(1), parameter, public :: & + LATTICE_BCC_NTWINSYSTEM = int([12], pInt) !< # of twin systems per family for bcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & - LATTICE_bcc_Nslip = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc - LATTICE_bcc_Ntwin = sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc + LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc + LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) - LATTICE_bcc_Ntrans = sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc - real(pReal), dimension(3+3,LATTICE_bcc_Nslip), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & LATTICE_bcc_systemSlip = reshape(real([& ! Slip direction Plane normal ! Slip system <111>{110} @@ -443,38 +222,13 @@ module lattice 1,-1, 1, -1, 1, 2, & -1, 1, 1, 1,-1, 2, & 1, 1, 1, 1, 1,-2 & - ! Slip system <111>{123} - ! 1, 1,-1, 1, 2, 3, & - ! 1,-1, 1, -1, 2, 3, & - ! -1, 1, 1, 1,-2, 3, & - ! 1, 1, 1, 1, 2,-3, & - ! 1,-1, 1, 1, 3, 2, & - ! 1, 1,-1, -1, 3, 2, & - ! 1, 1, 1, 1,-3, 2, & - ! -1, 1, 1, 1, 3,-2, & - ! 1, 1,-1, 2, 1, 3, & - ! 1,-1, 1, -2, 1, 3, & - ! -1, 1, 1, 2,-1, 3, & - ! 1, 1, 1, 2, 1,-3, & - ! 1,-1, 1, 2, 3, 1, & - ! 1, 1,-1, -2, 3, 1, & - ! 1, 1, 1, 2,-3, 1, & - ! -1, 1, 1, 2, 3,-1, & - ! -1, 1, 1, 3, 1, 2, & - ! 1, 1, 1, -3, 1, 2, & - ! 1, 1,-1, 3,-1, 2, & - ! 1,-1, 1, 3, 1,-2, & - ! -1, 1, 1, 3, 2, 1, & - ! 1, 1, 1, -3, 2, 1, & - ! 1, 1,-1, 3,-2, 1, & - ! 1,-1, 1, 3, 2,-1 & - ],pReal),[ 3_pInt + 3_pInt ,LATTICE_bcc_Nslip]) + ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) character(len=*), dimension(2), parameter, public :: LATTICE_BCC_SLIPFAMILY_NAME = & ['<1 -1 1>{0 1 1}', & '<1 -1 1>{2 1 1}'] - real(pReal), dimension(3+3,LATTICE_bcc_Ntwin), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: & LATTICE_bcc_systemTwin = reshape(real([& ! Twin system <111>{112} -1, 1, 1, 2, 1, 1, & @@ -489,15 +243,14 @@ module lattice 1,-1, 1, -1, 1, 2, & -1, 1, 1, 1,-1, 2, & 1, 1, 1, 1, 1,-2 & - ],pReal),[ 3_pInt + 3_pInt,LATTICE_bcc_Ntwin]) + ],pReal),shape(LATTICE_BCC_SYSTEMTWIN)) character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] - real(pReal), dimension(LATTICE_bcc_Ntwin), parameter, private :: & - LATTICE_bcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) - integer(pInt), dimension(LATTICE_bcc_Nslip,LATTICE_bcc_Nslip), parameter, public :: & + + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter, public :: & LATTICE_bcc_interactionSlipSlip = reshape(int( [& 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & ! ---> slip 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & ! | @@ -524,65 +277,14 @@ module lattice 3,4,6,6,6,6,4,3,4,3,6,6, 6,5,6,3,3,5,6,6,6,1,5,6, & 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,5,6,6,6,5,3,6,5,1,6, & 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,6,5,6,6,3,5,5,6,6,1 & - ],pInt),[lattice_bcc_Nslip,lattice_bcc_Nslip],order=[2,1]) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 + ],pInt),shape(LATTICE_BCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 !< 1: self interaction !< 2: coplanar interaction !< 3: collinear interaction !< 4: mixed-asymmetrical junction !< 5: mixed-symmetrical junction !< 6: edge junction - integer(pInt), dimension(LATTICE_bcc_Nslip,LATTICE_bcc_Ntwin), parameter, public :: & - LATTICE_bcc_interactionSlipTwin = reshape(int( [& - 3,3,3,2,2,3,3,3,3,2,3,3, & ! ---> twin - 3,3,2,3,3,2,3,3,2,3,3,3, & ! | - 3,2,3,3,3,3,2,3,3,3,3,2, & ! | - 2,3,3,3,3,3,3,2,3,3,2,3, & ! v slip - 2,3,3,3,3,3,3,2,3,3,2,3, & - 3,3,2,3,3,2,3,3,2,3,3,3, & - 3,2,3,3,3,3,2,3,3,3,3,2, & - 3,3,3,2,2,3,3,3,3,2,3,3, & - 2,3,3,3,3,3,3,2,3,3,2,3, & - 3,3,3,2,2,3,3,3,3,2,3,3, & - 3,2,3,3,3,3,2,3,3,3,3,2, & - 3,3,2,3,3,2,3,3,2,3,3,3, & - ! - 1,3,3,3,3,3,3,2,3,3,2,3, & - 3,1,3,3,3,3,2,3,3,3,3,2, & - 3,3,1,3,3,2,3,3,2,3,3,3, & - 3,3,3,1,2,3,3,3,3,2,3,3, & - 3,3,3,2,1,3,3,3,3,2,3,3, & - 3,3,2,3,3,1,3,3,2,3,3,3, & - 3,2,3,3,3,3,1,3,3,3,3,2, & - 2,3,3,3,3,3,3,1,3,3,2,3, & - 3,3,2,3,3,2,3,3,1,3,3,3, & - 3,3,3,2,2,3,3,3,3,1,3,3, & - 2,3,3,3,3,3,3,2,3,3,1,3, & - 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),[LATTICE_bcc_Nslip,LATTICE_bcc_Ntwin],order=[2,1]) !< Slip--twin interaction types for bcc - !< 1: coplanar interaction - !< 2: screw trace between slip system and twin habit plane (easy cross slip) - !< 3: other interaction - integer(pInt), dimension(LATTICE_bcc_Ntwin,LATTICE_bcc_Nslip), parameter, public :: & - LATTICE_bcc_interactionTwinSlip = 1_pInt !< Twin--slip interaction types for bcc @todo not implemented yet - integer(pInt), dimension(LATTICE_bcc_Ntwin,LATTICE_bcc_Ntwin), parameter, public :: & - LATTICE_bcc_interactionTwinTwin = reshape(int( [& - 1,3,3,3,3,3,3,2,3,3,2,3, & ! ---> twin - 3,1,3,3,3,3,2,3,3,3,3,2, & ! | - 3,3,1,3,3,2,3,3,2,3,3,3, & ! | - 3,3,3,1,2,3,3,3,3,2,3,3, & ! v twin - 3,3,3,2,1,3,3,3,3,2,3,3, & - 3,3,2,3,3,1,3,3,2,3,3,3, & - 3,2,3,3,3,3,1,3,3,3,3,2, & - 2,3,3,3,3,3,3,1,3,3,2,3, & - 3,3,2,3,3,2,3,3,1,3,3,3, & - 3,3,3,2,2,3,3,3,3,1,3,3, & - 2,3,3,3,3,3,3,2,3,3,1,3, & - 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),[LATTICE_bcc_Ntwin,LATTICE_bcc_Ntwin],order=[2,1]) !< Twin--twin interaction types for bcc - !< 1: self interaction - !< 2: collinear interaction - !< 3: other interaction real(pReal), dimension(3+3,LATTICE_bcc_Ncleavage), parameter, private :: & LATTICE_bcc_systemCleavage = reshape(real([& ! Cleavage direction Plane normal @@ -595,30 +297,25 @@ module lattice 1, 1, 1, -1, 0, 1, & -1, 1, 1, 1, 1, 0, & 1, 1, 1, -1, 1, 0 & - ],pReal),[ 3_pInt + 3_pInt,LATTICE_bcc_Ncleavage]) + ],pReal),shape(LATTICE_BCC_SYSTEMCLEAVAGE)) !-------------------------------------------------------------------------------------------------- ! hexagonal integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex + LATTICE_HEX_NSLIPSYSTEM = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_hex_NtransSystem = int([0],pInt) !< # of transformation systems per family for hex + integer(pInt), dimension(4), parameter, public :: & + LATTICE_HEX_NTWINSYSTEM = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & - LATTICE_hex_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex - LATTICE_hex_Ntwin = sum(lattice_hex_NtwinSystem), & !< total # of twin systems for hex - LATTICE_hex_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for hex - LATTICE_hex_Ntrans = sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex + LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSystem), & !< total # of slip systems for hex + LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex - real(pReal), dimension(4+4,LATTICE_hex_Nslip), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: & LATTICE_hex_systemSlip = reshape(real([& ! Slip direction Plane normal ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base)) @@ -660,7 +357,7 @@ module lattice -2, 1, 1, 3, 2, -1, -1, 2, & 1, -2, 1, 3, -1, 2, -1, 2, & 1, 1, -2, 3, -1, -1, 2, 2 & - ],pReal),[ 4_pInt + 4_pInt,LATTICE_hex_Nslip]) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr + ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr character(len=*), dimension(6), parameter, public :: LATTICE_HEX_SLIPFAMILY_NAME = & ['<1 1 . 1>{0 0 . 1} ', & @@ -700,7 +397,7 @@ module lattice -2, 1, 1, -3, -2, 1, 1, 2, & 1, -2, 1, -3, 1, -2, 1, 2, & 1, 1, -2, -3, 1, 1, -2, 2 & - ],pReal),[ 4_pInt + 4_pInt ,LATTICE_hex_Ntwin]) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 + ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 character(len=*), dimension(4), parameter, public :: LATTICE_HEX_TWINFAMILY_NAME = & ['<-1 0 . 1>{1 0 . 2} ', & @@ -708,35 +405,8 @@ module lattice '<1 0 . -2>{1 0 . 1} ', & '<1 1 . -3>{1 1 . 2} '] - integer(pInt), dimension(LATTICE_hex_Ntwin), parameter, private :: & - LATTICE_hex_shearTwin = reshape(int( [& ! indicator to formula further below - 1, & ! <-10.1>{10.2} - 1, & - 1, & - 1, & - 1, & - 1, & - 2, & ! <11.6>{-1-1.1} - 2, & - 2, & - 2, & - 2, & - 2, & - 3, & ! <10.-2>{10.1} - 3, & - 3, & - 3, & - 3, & - 3, & - 4, & ! <11.-3>{11.2} - 4, & - 4, & - 4, & - 4, & - 4 & - ],pInt),[LATTICE_hex_Ntwin]) - integer(pInt), dimension(LATTICE_hex_Nslip,LATTICE_hex_Nslip), parameter, public :: & + integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter, public :: & LATTICE_hex_interactionSlipSlip = reshape(int( [& 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! ---> slip 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | @@ -776,113 +446,8 @@ module lattice 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,36,37,37, & 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,36,37, & 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,37,36 & - ! - ],pInt),[LATTICE_hex_Nslip,LATTICE_hex_Nslip],order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) + ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) - integer(pInt), dimension(LATTICE_hex_Nslip,LATTICE_hex_Ntwin), parameter, public :: & - LATTICE_hex_interactionSlipTwin = reshape(int( [& - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! --> twin - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | - ! v - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & - ! - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - ! - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - ! - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - ! - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & - ! - ],pInt),[LATTICE_hex_Nslip,LATTICE_hex_Ntwin],order=[2,1]) !< Slip--twin interaction types for hex (isotropic, 24 in total) - - integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Nslip), parameter, public :: & - LATTICE_hex_interactionTwinSlip = reshape(int( [& - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! --> slip - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! v - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! twin - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & - ! - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - ! - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - ! - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & - ],pInt),[LATTICE_hex_Ntwin,LATTICE_hex_Nslip],order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 20 in total) - - integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Ntwin), parameter, public :: & - LATTICE_hex_interactionTwinTwin = reshape(int( [& - 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! ---> twin - 2, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | - 2, 2, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | - 2, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! v twin - 2, 2, 2, 2, 1, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - 2, 2, 2, 2, 2, 1, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - ! - 6, 6, 6, 6, 6, 6, 4, 5, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 4, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 4, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 4, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 4, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 4, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - ! - 12,12,12,12,12,12, 11,11,11,11,11,11, 9,10,10,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10, 9,10,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10, 9,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10, 9,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10, 9,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10,10, 9, 15,15,15,15,15,15, & - ! - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 16,17,17,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,16,17,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,16,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & - ],pInt),[lattice_hex_Ntwin,lattice_hex_Ntwin],order=[2,1]) !< Twin--slip interaction types for hex (isotropic, 16 in total) real(pReal), dimension(4+4,LATTICE_hex_Ncleavage), parameter, private :: & LATTICE_hex_systemCleavage = reshape(real([& @@ -890,7 +455,7 @@ module lattice 2,-1,-1, 0, 0, 0, 0, 1, & 0, 0, 0, 1, 2,-1,-1, 0, & 0, 0, 0, 1, 0, 1,-1, 0 & - ],pReal),[ 4_pInt + 4_pInt,LATTICE_hex_Ncleavage]) + ],pReal),shape(LATTICE_HEX_SYSTEMCLEAVAGE)) !-------------------------------------------------------------------------------------------------- @@ -898,21 +463,8 @@ module lattice integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & LATTICE_bct_NslipSystem = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_bct_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for bct - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bct_NtransSystem = int([0],pInt) !< # of transformation systems per family for bct - - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bct_NcleavageSystem = int([0, 0, 0],pInt) !< # of cleavage systems per family for bct - integer(pInt), parameter, private :: & - LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct - LATTICE_bct_Ntwin = sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct - LATTICE_bct_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for bct - LATTICE_bct_Ntrans = sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct - LATTICE_bct_Ncleavage = sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct + LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem) !< total # of slip systems for bct real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: & LATTICE_bct_systemSlip = reshape(real([& @@ -1065,28 +617,15 @@ module lattice 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,169,170,170, & 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,169,170, & 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,169 & - ],pInt),[lattice_bct_Nslip,lattice_bct_Nslip],order=[2,1]) + !-------------------------------------------------------------------------------------------------- ! isotropic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_iso_NslipSystem = int([0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ],pInt) !< # of slip systems per family for iso - - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_iso_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for iso - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_iso_NtransSystem = int([0],pInt) !< # of transformation systems per family for iso - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso integer(pInt), parameter, private :: & - LATTICE_iso_Nslip = sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso - LATTICE_iso_Ntwin = sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso - LATTICE_iso_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for iso - LATTICE_iso_Ntrans = sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso LATTICE_iso_Ncleavage = sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso real(pReal), dimension(3+3,LATTICE_iso_Ncleavage), parameter, private :: & @@ -1097,108 +636,54 @@ module lattice 1, 0, 0, 0, 0, 1 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_iso_Ncleavage]) + !-------------------------------------------------------------------------------------------------- ! orthorhombic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_ortho_NslipSystem = int([0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ],pInt) !< # of slip systems per family for ortho - - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_ortho_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for ortho - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_ortho_NtransSystem = int([0],pInt) !< # of transformation systems per family for ortho - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_ortho_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho + LATTICE_ort_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & - LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho - LATTICE_ortho_Ntwin = sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho - LATTICE_ortho_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for ortho - LATTICE_ortho_Ntrans = sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho - LATTICE_ortho_Ncleavage = sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho + LATTICE_ort_Ncleavage = sum(lattice_ort_NcleavageSystem) !< total # of cleavage systems for ortho - real(pReal), dimension(3+3,LATTICE_ortho_Ncleavage), parameter, private :: & - LATTICE_ortho_systemCleavage = reshape(real([& + real(pReal), dimension(3+3,LATTICE_ort_Ncleavage), parameter, private :: & + LATTICE_ort_systemCleavage = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & 0, 0, 1, 0, 1, 0, & 1, 0, 0, 0, 0, 1 & - ],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage]) + ],pReal),[ 3_pInt + 3_pInt,LATTICE_ort_Ncleavage]) ! BEGIN DEPRECATED integer(pInt), parameter, public :: & - LATTICE_maxNslip = max(LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & - LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = max(LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & - LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin), & !< max # of twin systems over lattice structures - LATTICE_maxNnonSchmid = max(LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & - LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & - LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid), & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = max(LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & - LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans), & !< max # of transformation systems over lattice structures + LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_HEX_NSLIP, & + LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures + LATTICE_maxNnonSchmid = LATTICE_bcc_NnonSchmid, & !< max # of non-Schmid contributions over lattice structures LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & - LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage), & !< max # of cleavage systems over lattice structures -#if defined(__GFORTRAN__) - ! only supported in gcc 8 + LATTICE_hex_Ncleavage, & + LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage), & !< max # of cleavage systems over lattice structures LATTICE_maxNinteraction = 182_pInt -#else - LATTICE_maxNinteraction = max(& - maxval(lattice_fcc_interactionSlipSlip), & - maxval(lattice_bcc_interactionSlipSlip), & - maxval(lattice_hex_interactionSlipSlip), & - maxval(lattice_bct_interactionSlipSlip), & - ! - maxval(lattice_fcc_interactionSlipTwin), & - maxval(lattice_bcc_interactionSlipTwin), & - maxval(lattice_hex_interactionSlipTwin), & - !maxval(lattice_bct_interactionSlipTwin), & - ! - maxval(lattice_fcc_interactionTwinSlip), & - maxval(lattice_bcc_interactionTwinSlip), & - maxval(lattice_hex_interactionTwinSlip), & - !maxval(lattice_bct_interactionTwinSlip), & - ! - maxval(lattice_fcc_interactionTwinTwin), & - maxval(lattice_bcc_interactionTwinTwin), & - maxval(lattice_hex_interactionTwinTwin) & - !maxval(lattice_bct_interactionTwinTwin))) - ) !< max # of interaction types (in hardening matrix part) -#endif !END DEPRECATED - real(pReal), dimension(:,:,:), allocatable, private :: & - temp66 + real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_C66 real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & - lattice_C3333, lattice_trans_C3333 + lattice_C3333 real(pReal), dimension(:), allocatable, public, protected :: & lattice_mu, lattice_nu + +! SHOULD NOT BE PART OF LATTICE BEGIN real(pReal), dimension(:,:,:,:), allocatable, public, protected :: & ! with higher-order parameters (e.g. temperature-dependent) lattice_thermalExpansion33 real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_thermalConductivity33, & - lattice_damageDiffusion33, & - lattice_vacancyfluxDiffusion33, & - lattice_vacancyfluxMobility33, & - lattice_porosityDiffusion33, & - lattice_hydrogenfluxDiffusion33, & - lattice_hydrogenfluxMobility33 + lattice_damageDiffusion33 real(pReal), dimension(:), allocatable, public, protected :: & lattice_damageMobility, & - lattice_porosityMobility, & lattice_massDensity, & lattice_specificHeat, & - lattice_vacancyFormationEnergy, & - lattice_vacancySurfaceEnergy, & - lattice_vacancyVol, & - lattice_hydrogenFormationEnergy, & - lattice_hydrogenSurfaceEnergy, & - lattice_hydrogenVol, & - lattice_referenceTemperature, & - lattice_equilibriumVacancyConcentration, & - lattice_equilibriumHydrogenConcentration + lattice_referenceTemperature +! SHOULD NOT BE PART OF LATTICE END + enum, bind(c) enumerator :: LATTICE_undefined_ID, & LATTICE_iso_ID, & @@ -1211,49 +696,6 @@ module lattice integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public, protected :: & lattice_structure, trans_lattice_structure - integer(pInt), dimension(2), parameter, private :: & - lattice_NsymOperations = [24_pInt,12_pInt] - -real(pReal), dimension(4,36), parameter, private :: & - lattice_symOperations = reshape([& - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations - 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry - -0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & - 0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & - -0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & - 0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & - -0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & - 0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & - -0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry - 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & -! - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations - 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry - 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & - 0.0_pReal, 0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & - 0.0_pReal, -0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & - 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & - 0.0_pReal, -2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & - 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry - -2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & - 0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & - -0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & - 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & - ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 public :: & lattice_init, & @@ -1264,12 +706,19 @@ real(pReal), dimension(4,36), parameter, private :: & LATTICE_hex_ID, & lattice_SchmidMatrix_slip, & lattice_SchmidMatrix_twin, & + lattice_SchmidMatrix_trans, & + lattice_SchmidMatrix_cleavage, & lattice_nonSchmidMatrix, & lattice_interaction_SlipSlip, & lattice_interaction_TwinTwin, & + lattice_interaction_TransTrans, & lattice_interaction_SlipTwin, & + lattice_interaction_SlipTrans, & lattice_interaction_TwinSlip, & - lattice_characteristicShear_Twin + lattice_forestProjection, & + lattice_characteristicShear_Twin, & + lattice_C66_twin, & + lattice_C66_trans contains @@ -1295,10 +744,8 @@ subroutine lattice_init integer(pInt) :: i,p real(pReal), dimension(:), allocatable :: & temp, & - CoverA, & !< c/a ratio for low symmetry type lattice - CoverA_trans, & !< c/a ratio for transformed hex type lattice - a_fcc, & !< lattice parameter a for fcc austenite - a_bcc !< lattice paramater a for bcc martensite + CoverA !< c/a ratio for low symmetry type lattice + write(6,'(/,a)') ' <<<+- lattice init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -1309,30 +756,15 @@ subroutine lattice_init allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(lattice_C66(6,6,Nphases), source=0.0_pReal) - allocate(temp66(6,6,Nphases), source=0.0_pReal) allocate(lattice_C3333(3,3,3,3,Nphases), source=0.0_pReal) - allocate(lattice_trans_C3333(3,3,3,3,Nphases), source=0.0_pReal) + allocate(lattice_thermalExpansion33 (3,3,3,Nphases), source=0.0_pReal) ! constant, linear, quadratic coefficients allocate(lattice_thermalConductivity33 (3,3,Nphases), source=0.0_pReal) allocate(lattice_damageDiffusion33 (3,3,Nphases), source=0.0_pReal) - allocate(lattice_vacancyfluxDiffusion33 (3,3,Nphases), source=0.0_pReal) - allocate(lattice_vacancyfluxMobility33 (3,3,Nphases), source=0.0_pReal) - allocate(lattice_PorosityDiffusion33 (3,3,Nphases), source=0.0_pReal) - allocate(lattice_hydrogenfluxDiffusion33(3,3,Nphases), source=0.0_pReal) - allocate(lattice_hydrogenfluxMobility33 (3,3,Nphases), source=0.0_pReal) allocate(lattice_damageMobility ( Nphases), source=0.0_pReal) - allocate(lattice_PorosityMobility ( Nphases), source=0.0_pReal) allocate(lattice_massDensity ( Nphases), source=0.0_pReal) allocate(lattice_specificHeat ( Nphases), source=0.0_pReal) - allocate(lattice_vacancyFormationEnergy ( Nphases), source=0.0_pReal) - allocate(lattice_vacancySurfaceEnergy ( Nphases), source=0.0_pReal) - allocate(lattice_vacancyVol ( Nphases), source=0.0_pReal) - allocate(lattice_hydrogenFormationEnergy( Nphases), source=0.0_pReal) - allocate(lattice_hydrogenSurfaceEnergy ( Nphases), source=0.0_pReal) - allocate(lattice_hydrogenVol ( Nphases), source=0.0_pReal) allocate(lattice_referenceTemperature ( Nphases), source=300.0_pReal) - allocate(lattice_equilibriumVacancyConcentration(Nphases), source=0.0_pReal) - allocate(lattice_equilibriumHydrogenConcentration(Nphases),source=0.0_pReal) allocate(lattice_mu(Nphases), source=0.0_pReal) allocate(lattice_nu(Nphases), source=0.0_pReal) @@ -1340,42 +772,15 @@ subroutine lattice_init allocate(lattice_NnonSchmid(Nphases), source=0_pInt) allocate(lattice_Sslip(3,3,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_Sslip_v(6,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) + allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) + allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me + allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) - - allocate(lattice_Qtwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_Stwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_Stwin_v(6,lattice_maxNtwin,Nphases),source=0.0_pReal) - - allocate(lattice_shearTwin(lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_shearTrans(lattice_maxNtrans,Nphases),source=0.0_pReal) - - allocate(lattice_Qtrans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_Strans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_Strans_v(6,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_projectionTrans(lattice_maxNtrans,lattice_maxNtrans,Nphases),source=0.0_pReal) - - allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) - allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,Nphases),source=0_pInt) - allocate(lattice_NtransSystem(lattice_maxNtransFamily,Nphases),source=0_pInt) allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) - allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionSlipTwin(lattice_maxNslip,lattice_maxNtwin,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTwinSlip(lattice_maxNtwin,lattice_maxNslip,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionSlipTrans(lattice_maxNslip,lattice_maxNtrans,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTransSlip(lattice_maxNtrans,lattice_maxNslip,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTransTrans(lattice_maxNtrans,lattice_maxNtrans,Nphases),source=0_pInt) ! other:me - allocate(CoverA(Nphases),source=0.0_pReal) - allocate(CoverA_trans(Nphases),source=0.0_pReal) - allocate(a_fcc(Nphases),source=0.0_pReal) - allocate(a_bcc(Nphases),source=0.0_pReal) - allocate(lattice_td(3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_tt(3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_tn(3,lattice_maxNtwin,Nphases),source=0.0_pReal) allocate(lattice_sd(3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_st(3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_sn(3,lattice_maxNslip,Nphases),source=0.0_pReal) @@ -1417,20 +822,8 @@ subroutine lattice_init lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) - temp66(1,1,p) = config_phase(p)%getFloat('c11_trans',defaultVal=0.0_pReal) - temp66(1,2,p) = config_phase(p)%getFloat('c12_trans',defaultVal=0.0_pReal) - temp66(1,3,p) = config_phase(p)%getFloat('c13_trans',defaultVal=0.0_pReal) - temp66(2,2,p) = config_phase(p)%getFloat('c22_trans',defaultVal=0.0_pReal) - temp66(2,3,p) = config_phase(p)%getFloat('c23_trans',defaultVal=0.0_pReal) - temp66(3,3,p) = config_phase(p)%getFloat('c33_trans',defaultVal=0.0_pReal) - temp66(4,4,p) = config_phase(p)%getFloat('c44_trans',defaultVal=0.0_pReal) - temp66(5,5,p) = config_phase(p)%getFloat('c55_trans',defaultVal=0.0_pReal) - temp66(6,6,p) = config_phase(p)%getFloat('c66_trans',defaultVal=0.0_pReal) CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal) - CoverA_trans(p) = config_phase(p)%getFloat('c/a_trans',defaultVal=0.0_pReal) - a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) - a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) @@ -1444,36 +837,12 @@ subroutine lattice_init lattice_thermalExpansion33(3,3,1:size(temp),p) = temp lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) - lattice_vacancyFormationEnergy(p) = config_phase(p)%getFloat( 'vacancyformationenergy',defaultVal=0.0_pReal) - lattice_vacancySurfaceEnergy(p) = config_phase(p)%getFloat( 'vacancyvolume',defaultVal=0.0_pReal) - lattice_vacancyVol(p) = config_phase(p)%getFloat( 'vacancysurfaceenergy',defaultVal=0.0_pReal) - lattice_hydrogenFormationEnergy(p) = config_phase(p)%getFloat( 'hydrogenformationenergy',defaultVal=0.0_pReal) - lattice_hydrogenSurfaceEnergy(p) = config_phase(p)%getFloat( 'hydrogensurfaceenergy',defaultVal=0.0_pReal) - lattice_hydrogenVol(p) = config_phase(p)%getFloat( 'hydrogenvolume',defaultVal=0.0_pReal) lattice_massDensity(p) = config_phase(p)%getFloat( 'mass_density',defaultVal=0.0_pReal) lattice_referenceTemperature(p) = config_phase(p)%getFloat( 'reference_temperature',defaultVal=0.0_pReal) lattice_DamageDiffusion33(1,1,p) = config_phase(p)%getFloat( 'damage_diffusion11',defaultVal=0.0_pReal) lattice_DamageDiffusion33(2,2,p) = config_phase(p)%getFloat( 'damage_diffusion22',defaultVal=0.0_pReal) lattice_DamageDiffusion33(3,3,p) = config_phase(p)%getFloat( 'damage_diffusion33',defaultVal=0.0_pReal) lattice_DamageMobility(p) = config_phase(p)%getFloat( 'damage_mobility',defaultVal=0.0_pReal) - lattice_vacancyfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion11',defaultVal=0.0_pReal) - lattice_vacancyfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion22',defaultVal=0.0_pReal) - lattice_vacancyfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion33',defaultVal=0.0_pReal) - lattice_vacancyfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_mobility11',defaultVal=0.0_pReal) - lattice_vacancyfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_mobility22',defaultVal=0.0_pReal) - lattice_vacancyfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_mobility33',defaultVal=0.0_pReal) - lattice_PorosityDiffusion33(1,1,p) = config_phase(p)%getFloat( 'porosity_diffusion11',defaultVal=0.0_pReal) - lattice_PorosityDiffusion33(2,2,p) = config_phase(p)%getFloat( 'porosity_diffusion22',defaultVal=0.0_pReal) - lattice_PorosityDiffusion33(3,3,p) = config_phase(p)%getFloat( 'porosity_diffusion33',defaultVal=0.0_pReal) - lattice_PorosityMobility(p) = config_phase(p)%getFloat( 'porosity_mobility',defaultVal=0.0_pReal) - lattice_hydrogenfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion11',defaultVal=0.0_pReal) - lattice_hydrogenfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion22',defaultVal=0.0_pReal) - lattice_hydrogenfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion33',defaultVal=0.0_pReal) - lattice_hydrogenfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility11',defaultVal=0.0_pReal) - lattice_hydrogenfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility22',defaultVal=0.0_pReal) - lattice_hydrogenfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility33',defaultVal=0.0_pReal) - lattice_equilibriumVacancyConcentration(p) = config_phase(p)%getFloat( 'vacancy_eqcv',defaultVal=0.0_pReal) - lattice_equilibriumHydrogenConcentration(p) = config_phase(p)%getFloat( 'hydrogen_eqch',defaultVal=0.0_pReal) enddo do i = 1_pInt,Nphases @@ -1481,16 +850,16 @@ subroutine lattice_init .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a if ((CoverA(i) > 2.0_pReal) & .and. lattice_structure(i) == LATTICE_bct_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a - call lattice_initializeStructure(i, CoverA(i), CoverA_trans(i), a_fcc(i), a_bcc(i)) + call lattice_initializeStructure(i, CoverA(i)) enddo end subroutine lattice_init !-------------------------------------------------------------------------------------------------- -!> @brief Calculation of Schmid matrices, etc. +!> @brief !!!!!!!DEPRECTATED!!!!!! !-------------------------------------------------------------------------------------------------- -subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) +subroutine lattice_initializeStructure(myPhase,CoverA) use prec, only: & tol_math_check use math, only: & @@ -1498,11 +867,10 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) math_tensorproduct33, & math_mul33x33, & math_mul33x3, & - math_transpose33, & math_trace33, & math_symmetric33, & - math_Mandel33to6, & - math_Mandel3333to66, & + math_sym33to6, & + math_sym3333to66, & math_Voigt66to3333, & math_axisAngleToR, & INRAD, & @@ -1514,36 +882,18 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) implicit none integer(pInt), intent(in) :: myPhase real(pReal), intent(in) :: & - CoverA, & - CoverA_trans, & - a_fcc, & - a_bcc + CoverA real(pReal), dimension(3) :: & sdU, snU, & np, nn - real(pReal), dimension(3,3) :: & - sstr, sdtr, sttr real(pReal), dimension(3,lattice_maxNslip) :: & sd, sn real(pReal), dimension(3,3,2,lattice_maxNnonSchmid,lattice_maxNslip) :: & sns - real(pReal), dimension(3,lattice_maxNtwin) :: & - td, tn - real(pReal), dimension(lattice_maxNtwin) :: & - ts - real(pReal), dimension(lattice_maxNtrans) :: & - trs - real(pReal), dimension(3,lattice_maxNtrans) :: & - xtr, ytr, ztr - real(pReal), dimension(3,3,lattice_maxNtrans) :: & - Rtr, Utr, Btr, Qtr, Str - real(pReal), dimension(3,lattice_maxNcleavage) :: & - cd, cn, ct integer(pInt) :: & - i,j, & - myNslip = 0_pInt, myNtwin = 0_pInt, myNtrans = 0_pInt, myNcleavage = 0_pInt - real(pReal) :: c11bar, c12bar, c13bar, c14bar, c33bar, c44bar, A, B + j, i, & + myNslip, myNcleavage lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),& lattice_C66(1:6,1:6,myPhase)) @@ -1558,50 +908,12 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) + 6.0_pReal*lattice_C66(1,2,myPhase) & + 2.0_pReal*lattice_C66(4,4,myPhase))! C12iso/(C11iso+C12iso) with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 lattice_C3333(1:3,1:3,1:3,1:3,myPhase) = math_Voigt66to3333(lattice_C66(1:6,1:6,myPhase)) ! Literature data is Voigt - lattice_C66(1:6,1:6,myPhase) = math_Mandel3333to66(lattice_C3333(1:3,1:3,1:3,1:3,myPhase)) ! DAMASK uses Mandel + lattice_C66(1:6,1:6,myPhase) = math_sym3333to66(lattice_C3333(1:3,1:3,1:3,1:3,myPhase)) ! DAMASK uses Mandel-weighting do i = 1_pInt, 6_pInt if (abs(lattice_C66(i,i,myPhase))bcc transformation') - enddo - case (LATTICE_hex_ID) - c11bar = (lattice_C66(1,1,myPhase) + lattice_C66(1,2,myPhase) + 2.0_pReal*lattice_C66(4,4,myPhase))/2.0_pReal - c12bar = (lattice_C66(1,1,myPhase) + 5.0_pReal*lattice_C66(1,2,myPhase) - 2.0_pReal*lattice_C66(4,4,myPhase))/6.0_pReal - c33bar = (lattice_C66(1,1,myPhase) + 2.0_pReal*lattice_C66(1,2,myPhase) + 4.0_pReal*lattice_C66(4,4,myPhase))/3.0_pReal - c13bar = (lattice_C66(1,1,myPhase) + 2.0_pReal*lattice_C66(1,2,myPhase) - 2.0_pReal*lattice_C66(4,4,myPhase))/3.0_pReal - c44bar = (lattice_C66(1,1,myPhase) - lattice_C66(1,2,myPhase) + lattice_C66(4,4,myPhase))/3.0_pReal - c14bar = (lattice_C66(1,1,myPhase) - lattice_C66(1,2,myPhase) - 2.0_pReal*lattice_C66(4,4,myPhase)) & - /(3.0_pReal*sqrt(2.0_pReal)) - A = c14bar**(2.0_pReal)/c44bar - B = c14bar**(2.0_pReal)/(0.5_pReal*(c11bar - c12bar)) - temp66(1,1,myPhase) = c11bar - A - temp66(1,2,myPhase) = c12bar + A - temp66(1,3,myPhase) = c13bar - temp66(3,3,myPhase) = c33bar - temp66(4,4,myPhase) = c44bar - B - - temp66(1:6,1:6,myPhase) = lattice_symmetrizeC66(trans_lattice_structure(myPhase),& - temp66(1:6,1:6,myPhase)) - lattice_trans_C3333(1:3,1:3,1:3,1:3,myPhase) = math_Voigt66to3333(temp66(1:6,1:6,myPhase)) - temp66(1:6,1:6,myPhase) = math_Mandel3333to66(lattice_trans_C3333(1:3,1:3,1:3,1:3,myPhase)) - do i = 1_pInt, 6_pInt - if (abs(temp66(i,i,myPhase))hex transformation') - enddo - end select - end select - forall (i = 1_pInt:3_pInt) & lattice_thermalExpansion33 (1:3,1:3,i,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_thermalExpansion33 (1:3,1:3,i,myPhase)) @@ -1610,107 +922,41 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_thermalConductivity33 (1:3,1:3,myPhase)) lattice_DamageDiffusion33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_DamageDiffusion33 (1:3,1:3,myPhase)) - lattice_vacancyfluxDiffusion33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& - lattice_vacancyfluxDiffusion33 (1:3,1:3,myPhase)) - lattice_vacancyfluxMobility33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& - lattice_vacancyfluxMobility33 (1:3,1:3,myPhase)) - lattice_PorosityDiffusion33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& - lattice_PorosityDiffusion33 (1:3,1:3,myPhase)) - lattice_hydrogenfluxDiffusion33(1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& - lattice_hydrogenfluxDiffusion33(1:3,1:3,myPhase)) - lattice_hydrogenfluxMobility33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& - lattice_hydrogenfluxMobility33 (1:3,1:3,myPhase)) + myNslip = 0_pInt + myNcleavage = 0_pInt select case(lattice_structure(myPhase)) !-------------------------------------------------------------------------------------------------- ! fcc case (LATTICE_fcc_ID) - myNslip = lattice_fcc_Nslip - myNtwin = lattice_fcc_Ntwin - myNtrans = lattice_fcc_Ntrans + myNslip = LATTICE_FCC_NSLIP myNcleavage = lattice_fcc_Ncleavage - do i = 1_pInt,myNslip ! assign slip system vectors + lattice_NslipSystem (1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavageSystem,'fcc',covera) + + do i = 1_pInt,myNslip sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears - td(1:3,i) = lattice_fcc_systemTwin(1:3,i) - tn(1:3,i) = lattice_fcc_systemTwin(4:6,i) - ts(i) = lattice_fcc_shearTwin(i) - enddo - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_fcc_systemCleavage(1:3,i)/norm2(lattice_fcc_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_fcc_systemCleavage(4:6,i)/norm2(lattice_fcc_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo - ! Phase transformation - select case(trans_lattice_structure(myPhase)) - case (LATTICE_bcc_ID) ! fcc to bcc transformation - do i = 1_pInt,myNtrans - Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation - lattice_fccTobcc_systemTrans(4,i)*INRAD) - Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system - lattice_fccTobcc_bainRot(4,i)*INRAD) - xtr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) - ytr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) - ztr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation - if ((a_fcc > 0.0_pReal) .and. (a_bcc > 0.0_pReal)) then - Utr(1:3,1:3,i) = (a_bcc/a_fcc)*math_tensorproduct33(xtr(1:3,i), xtr(1:3,i)) + & - sqrt(2.0_pReal)*(a_bcc/a_fcc)*math_tensorproduct33(ytr(1:3,i), ytr(1:3,i)) + & - sqrt(2.0_pReal)*(a_bcc/a_fcc)*math_tensorproduct33(ztr(1:3,i), ztr(1:3,i)) - endif - Qtr(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), Btr(1:3,1:3,i)) - Str(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), Utr(1:3,1:3,i)) - MATH_I3 - enddo - case (LATTICE_hex_ID) - sstr(1:3,1:3) = MATH_I3 - sstr(1,3) = sqrt(2.0_pReal)/4.0_pReal - sdtr(1:3,1:3) = MATH_I3 - if (CoverA_trans > 1.0_pReal .and. CoverA_trans < 2.0_pReal) then - sdtr(3,3) = CoverA_trans/sqrt(8.0_pReal/3.0_pReal) - endif - sttr = math_mul33x33(sdtr, sstr) - do i = 1_pInt,myNtrans - xtr(1:3,i) = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) - ztr(1:3,i) = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) - ytr(1:3,i) = -math_crossproduct(xtr(1:3,i), ztr(1:3,i)) - Rtr(1:3,1,i) = xtr(1:3,i) - Rtr(1:3,2,i) = ytr(1:3,i) - Rtr(1:3,3,i) = ztr(1:3,i) - Qtr(1:3,1:3,i) = Rtr(1:3,1:3,i) - Str(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), math_mul33x33(sttr, math_transpose33(Rtr(1:3,1:3,i)))) - Str(1:3,1:3,i) = Str(1:3,1:3,i) - MATH_I3 - trs(i) = lattice_fccTohex_shearTrans(i) - enddo - case default - Qtr = 0.0_pReal - Str = 0.0_pReal - end select - - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_fcc_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_fcc_NtransSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_fcc_NnonSchmid - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip - lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myPhase) = lattice_fcc_interactionSlipTwin - lattice_interactionTwinSlip(1:myNtwin,1:myNslip,myPhase) = lattice_fcc_interactionTwinSlip - lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myPhase) = lattice_fcc_interactionTwinTwin - lattice_interactionSlipTrans(1:myNslip,1:myNtrans,myPhase) = lattice_fccTohex_interactionSlipTrans - lattice_interactionTransSlip(1:myNtrans,1:myNslip,myPhase) = lattice_fccTohex_interactionTransSlip - lattice_interactionTransTrans(1:myNtrans,1:myNtrans,myPhase) = lattice_fccTohex_interactionTransTrans - lattice_projectionTrans(1:myNtrans,1:myNtrans,myPhase) = LATTICE_fccTobcc_projectionTrans*& - LATTICE_fccTobcc_projectionTransFactor !-------------------------------------------------------------------------------------------------- ! bcc case (LATTICE_bcc_ID) - myNslip = lattice_bcc_Nslip - myNtwin = lattice_bcc_Ntwin - myNtrans = lattice_bcc_Ntrans + myNslip = LATTICE_BCC_NSLIP myNcleavage = lattice_bcc_Ncleavage + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem + lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera) + do i = 1_pInt,myNslip ! assign slip system vectors sd(1:3,i) = lattice_bcc_systemSlip(1:3,i) sn(1:3,i) = lattice_bcc_systemSlip(4:6,i) @@ -1733,33 +979,19 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sns(1:3,1:3,1,6,i) = math_tensorproduct33(sdU, sdU) sns(1:3,1:3,2,6,i) = math_tensorproduct33(-sdU, -sdU) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears - td(1:3,i) = lattice_bcc_systemTwin(1:3,i) - tn(1:3,i) = lattice_bcc_systemTwin(4:6,i) - ts(i) = lattice_bcc_shearTwin(i) - enddo - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_bcc_systemCleavage(1:3,i)/norm2(lattice_bcc_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_bcc_systemCleavage(4:6,i)/norm2(lattice_bcc_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_bcc_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_bcc_NtransSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip - lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myPhase) = lattice_bcc_interactionSlipTwin - lattice_interactionTwinSlip(1:myNtwin,1:myNslip,myPhase) = lattice_bcc_interactionTwinSlip - lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myPhase) = lattice_bcc_interactionTwinTwin !-------------------------------------------------------------------------------------------------- ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) case (LATTICE_hex_ID) - myNslip = lattice_hex_Nslip - myNtwin = lattice_hex_Ntwin - myNtrans = lattice_hex_Ntrans + myNslip = LATTICE_HEX_NSLIP myNcleavage = lattice_hex_Ncleavage + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = LATTICE_HEX_NSLIPSystem + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_hex_ncleavagesystem,'hex',covera) + do i = 1_pInt,myNslip ! assign slip system vectors sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] sd(2,i) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*& @@ -1769,53 +1001,14 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears - td(1,i) = lattice_hex_systemTwin(1,i)*1.5_pReal - td(2,i) = (lattice_hex_systemTwin(1,i)+2.0_pReal*lattice_hex_systemTwin(2,i))*& - 0.5_pReal*sqrt(3.0_pReal) - td(3,i) = lattice_hex_systemTwin(4,i)*CoverA - tn(1,i) = lattice_hex_systemTwin(5,i) - tn(2,i) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))/sqrt(3.0_pReal) - tn(3,i) = lattice_hex_systemTwin(8,i)/CoverA - select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29 - case (1_pInt) ! <-10.1>{10.2} - ts(i) = (3.0_pReal-CoverA*CoverA)/sqrt(3.0_pReal)/CoverA - case (2_pInt) ! <11.6>{-1-1.1} - ts(i) = 1.0_pReal/CoverA - case (3_pInt) ! <10.-2>{10.1} - ts(i) = (4.0_pReal*CoverA*CoverA-9.0_pReal)/4.0_pReal/sqrt(3.0_pReal)/CoverA - case (4_pInt) ! <11.-3>{11.2} - ts(i) = 2.0_pReal*(CoverA*CoverA-2.0_pReal)/3.0_pReal/CoverA - end select - enddo - do i = 1_pInt, myNcleavage ! cleavage system vectors - cd(1,i) = lattice_hex_systemCleavage(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] - cd(2,i) = (lattice_hex_systemCleavage(1,i)+2.0_pReal*lattice_hex_systemCleavage(2,i))*& - 0.5_pReal*sqrt(3.0_pReal) - cd(3,i) = lattice_hex_systemCleavage(4,i)*CoverA - cd(1:3,1) = cd(1:3,i)/norm2(cd(1:3,i)) - cn(1,i) = lattice_hex_systemCleavage(5,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - cn(2,i) = (lattice_hex_systemCleavage(5,i)+2.0_pReal*lattice_hex_systemCleavage(6,i))/sqrt(3.0_pReal) - cn(3,i) = lattice_hex_systemCleavage(8,i)/CoverA - cn(1:3,1) = cn(1:3,i)/norm2(cn(1:3,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_hex_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_hex_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_hex_NtransSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_hex_NnonSchmid - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip - lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myPhase) = lattice_hex_interactionSlipTwin - lattice_interactionTwinSlip(1:myNtwin,1:myNslip,myPhase) = lattice_hex_interactionTwinSlip - lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myPhase) = lattice_hex_interactionTwinTwin !-------------------------------------------------------------------------------------------------- ! bct case (LATTICE_bct_ID) myNslip = lattice_bct_Nslip - myNtwin = lattice_bct_Ntwin - myNcleavage = lattice_bct_Ncleavage + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bct_interactionSlipSlip + do i = 1_pInt,myNslip ! assign slip system vectors sd(1:2,i) = lattice_bct_systemSlip(1:2,i) sd(3,i) = lattice_bct_systemSlip(3,i)*CoverA @@ -1824,41 +1017,25 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sdU = sd(1:3,i) / norm2(sd(1:3,i)) snU = sn(1:3,i) / norm2(sn(1:3,i)) enddo - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_bct_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_bct_NtransSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bct_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_bct_NnonSchmid - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bct_interactionSlipSlip !-------------------------------------------------------------------------------------------------- ! orthorhombic (no crystal plasticity) case (LATTICE_ort_ID) - myNslip = 0_pInt - myNtwin = 0_pInt - myNtrans = 0_pInt - myNcleavage = lattice_ortho_Ncleavage - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_iso_systemCleavage(1:3,i)/norm2(LATTICE_ortho_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_iso_systemCleavage(4:6,i)/norm2(LATTICE_ortho_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_iso_NcleavageSystem + myNcleavage = lattice_ort_Ncleavage + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_ort_NcleavageSystem + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_ort_NcleavageSystem,'ort',covera) !-------------------------------------------------------------------------------------------------- ! isotropic (no crystal plasticity) case (LATTICE_iso_ID) - myNslip = 0_pInt - myNtwin = 0_pInt - myNtrans = 0_pInt myNcleavage = lattice_iso_Ncleavage - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_iso_systemCleavage(1:3,i)/norm2(lattice_iso_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_iso_systemCleavage(4:6,i)/norm2(lattice_iso_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_iso_NcleavageSystem + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_iso_NcleavageSystem,'iso',covera) + !-------------------------------------------------------------------------------------------------- ! something went wrong case default @@ -1879,37 +1056,14 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) enddo do j = 1_pInt,1_pInt+2_pInt*lattice_NnonSchmid(myPhase) lattice_Sslip_v(1:6,j,i,myPhase) = & - math_Mandel33to6(math_symmetric33(lattice_Sslip(1:3,1:3,j,i,myPhase))) + math_sym33to6(math_symmetric33(lattice_Sslip(1:3,1:3,j,i,myPhase))) enddo - if (abs(math_trace33(lattice_Sslip(1:3,1:3,1,i,myPhase))) > tol_math_check) & - call IO_error(0_pInt,myPhase,i,0_pInt,ext_msg = 'dilatational slip Schmid matrix') enddo - do i = 1_pInt,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure - lattice_td(1:3,i,myPhase) = td(1:3,i)/norm2(td(1:3,i)) ! make unit vector - lattice_tn(1:3,i,myPhase) = tn(1:3,i)/norm2(tn(1:3,i)) ! make unit vector - lattice_tt(1:3,i,myPhase) = math_crossproduct(lattice_td(1:3,i,myPhase), & - lattice_tn(1:3,i,myPhase)) - lattice_Stwin(1:3,1:3,i,myPhase) = math_tensorproduct33(lattice_td(1:3,i,myPhase), & - lattice_tn(1:3,i,myPhase)) - lattice_Stwin_v(1:6,i,myPhase) = math_Mandel33to6(math_symmetric33(lattice_Stwin(1:3,1:3,i,myPhase))) - lattice_Qtwin(1:3,1:3,i,myPhase) = math_axisAngleToR(tn(1:3,i),180.0_pReal*INRAD) - lattice_shearTwin(i,myPhase) = ts(i) - if (abs(math_trace33(lattice_Stwin(1:3,1:3,i,myPhase))) > tol_math_check) & - call IO_error(301_pInt,myPhase,ext_msg = 'dilatational twin Schmid matrix') - enddo - do i = 1_pInt,myNtrans - lattice_Qtrans(1:3,1:3,i,myPhase) = Qtr(1:3,1:3,i) - lattice_Strans(1:3,1:3,i,myPhase) = Str(1:3,1:3,i) - lattice_Strans_v(1:6,i,myPhase) = math_Mandel33to6(math_symmetric33(lattice_Strans(1:3,1:3,i,myPhase))) - lattice_shearTrans(i,myPhase) = trs(i) - enddo - do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure - lattice_Scleavage(1:3,1:3,1,i,myPhase) = math_tensorproduct33(cd(1:3,i),cn(1:3,i)) - lattice_Scleavage(1:3,1:3,2,i,myPhase) = math_tensorproduct33(ct(1:3,i),cn(1:3,i)) - lattice_Scleavage(1:3,1:3,3,i,myPhase) = math_tensorproduct33(cn(1:3,i),cn(1:3,i)) + + do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure do j = 1_pInt,3_pInt lattice_Scleavage_v(1:6,j,i,myPhase) = & - math_Mandel33to6(math_symmetric33(lattice_Scleavage(1:3,1:3,j,i,myPhase))) + math_sym33to6(math_symmetric33(lattice_Scleavage(1:3,1:3,j,i,myPhase))) enddo enddo @@ -1918,6 +1072,7 @@ end subroutine lattice_initializeStructure !-------------------------------------------------------------------------------------------------- !> @brief Symmetrizes stiffness matrix according to lattice type +!> @details J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962 !-------------------------------------------------------------------------------------------------- pure function lattice_symmetrizeC66(struct,C66) @@ -1980,7 +1135,7 @@ pure function lattice_symmetrizeC66(struct,C66) lattice_symmetrizeC66(3,2) = C66(1,3) lattice_symmetrizeC66(4,4) = C66(4,4) lattice_symmetrizeC66(5,5) = C66(4,4) - lattice_symmetrizeC66(6,6) = C66(6,6) !J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962 + lattice_symmetrizeC66(6,6) = C66(6,6) case default lattice_symmetrizeC66 = C66 end select @@ -2076,6 +1231,50 @@ pure function lattice_qDisorientation(Q1, Q2, struct) integer(pInt) :: i,j,k,s,symmetry integer(kind(LATTICE_undefined_ID)) :: myStruct + integer(pInt), dimension(2), parameter :: & + NsymOperations = [24_pInt,12_pInt] + +real(pReal), dimension(4,36), parameter :: & + symOperations = reshape([& + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations + 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry + -0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & + 0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & + -0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & + 0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & + -0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & + 0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & + -0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry + 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & +! + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations + 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry + 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & + 0.0_pReal, 0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & + 0.0_pReal, -0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & + 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & + 0.0_pReal, -2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & + 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry + -2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & + 0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & + -0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & + 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & + ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 + !-------------------------------------------------------------------------------------------------- ! check if a structure with known symmetries is given if (present(struct)) then @@ -2102,13 +1301,13 @@ pure function lattice_qDisorientation(Q1, Q2, struct) select case(symmetry) case (1_pInt,2_pInt) - s = sum(lattice_NsymOperations(1:symmetry-1_pInt)) + s = sum(NsymOperations(1:symmetry-1_pInt)) do i = 1_pInt,2_pInt dQ = math_qConj(dQ) ! switch order of "from -- to" - do j = 1_pInt,lattice_NsymOperations(symmetry) ! run through first crystal's symmetries - dQsymA = math_qMul(lattice_symOperations(1:4,s+j),dQ) ! apply sym - do k = 1_pInt,lattice_NsymOperations(symmetry) ! run through 2nd crystal's symmetries - mis = math_qMul(dQsymA,lattice_symOperations(1:4,s+k)) ! apply sym + do j = 1_pInt,NsymOperations(symmetry) ! run through first crystal's symmetries + dQsymA = math_qMul(symOperations(1:4,s+j),dQ) ! apply sym + do k = 1_pInt,NsymOperations(symmetry) ! run through 2nd crystal's symmetries + mis = math_qMul(dQsymA,symOperations(1:4,s+k)) ! apply sym if (mis(1) < 0.0_pReal) & ! want positive angle mis = -mis if (mis(1)-lattice_qDisorientation(1) > -tol_math_check & @@ -2122,51 +1321,77 @@ end function lattice_qDisorientation !-------------------------------------------------------------------------------------------------- -!> @brief Provides characteristtic shear for twinning +!> @brief Characteristic shear for twinning !-------------------------------------------------------------------------------------------------- function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(characteristicShear) use IO, only: & IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - character(len=3), intent(in) :: structure - real(pReal), intent(in), optional :: & - cOverA - real(pReal), dimension(sum(Ntwin)) :: characteristicShear + integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + character(len=3), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Ntwin)) :: characteristicShear integer(pInt) :: & - ir, & !< index in reduced list - ig, & !< index in full list + a, & !< index of active system + c, & !< index in complete system list mf, & !< index of my family ms !< index of my system in current family - ir = 0_pInt + integer(pInt), dimension(LATTICE_HEX_NTWIN), parameter :: & + HEX_SHEARTWIN = reshape(int( [& + 1, & ! <-10.1>{10.2} + 1, & + 1, & + 1, & + 1, & + 1, & + 2, & ! <11.6>{-1-1.1} + 2, & + 2, & + 2, & + 2, & + 2, & + 3, & ! <10.-2>{10.1} + 3, & + 3, & + 3, & + 3, & + 3, & + 4, & ! <11.-3>{11.2} + 4, & + 4, & + 4, & + 4, & + 4 & + ],pInt),[LATTICE_HEX_NTWIN]) ! indicator to formulas below + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_characteristicShear_Twin: '//trim(structure)) + + a = 0_pInt myFamilies: do mf = 1_pInt,size(Ntwin,1) mySystems: do ms = 1_pInt,Ntwin(mf) - ir = ir + 1_pInt - ig = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms - select case(structure) - case('fcc') - ig = sum(LATTICE_FCC_NTWINSYSTEM(1:mf-1))+ms - characteristicShear(ir) = LATTICE_FCC_SHEARTWIN(ig) - case('bcc') - ig = sum(LATTICE_BCC_NTWINSYSTEM(1:mf-1))+ms - characteristicShear(ir) = LATTICE_BCC_SHEARTWIN(ig) + a = a + 1_pInt + select case(structure(1:3)) + case('fcc','bcc') + characteristicShear(a) = 0.5_pReal*sqrt(2.0_pReal) case('hex') - if (.not. present(CoverA)) call IO_error(0_pInt) - ig = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms - select case(LATTICE_HEX_SHEARTWIN(ig)) ! from Christian & Mahajan 1995 p.29 + if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) & + call IO_error(131_pInt,ext_msg='lattice_characteristicShear_Twin') + c = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms + select case(HEX_SHEARTWIN(c)) ! from Christian & Mahajan 1995 p.29 case (1_pInt) ! <-10.1>{10.2} - characteristicShear(ir) = (3.0_pReal-cOverA*cOverA)/sqrt(3.0_pReal)/CoverA + characteristicShear(a) = (3.0_pReal-cOverA**2.0_pReal)/sqrt(3.0_pReal)/CoverA case (2_pInt) ! <11.6>{-1-1.1} - characteristicShear(ir) = 1.0_pReal/cOverA + characteristicShear(a) = 1.0_pReal/cOverA case (3_pInt) ! <10.-2>{10.1} - characteristicShear(ir) = (4.0_pReal*cOverA*cOverA-9.0_pReal)/4.0_pReal & - / sqrt(3.0_pReal)/cOverA - !characteristicShear(ir) = (4.0_pReal*cOverA*cOverA-9.0_pReal)/sqrt(48.0_pReal)/cOverA + characteristicShear(a) = (4.0_pReal*cOverA**2.0_pReal-9.0_pReal)/sqrt(48.0_pReal)/cOverA case (4_pInt) ! <11.-3>{11.2} - characteristicShear(ir) = 2.0_pReal*(cOverA*cOverA-2.0_pReal)/3.0_pReal/cOverA + characteristicShear(a) = 2.0_pReal*(cOverA**2.0_pReal-2.0_pReal)/3.0_pReal/cOverA end select + case default + call IO_error(137_pInt,ext_msg='lattice_characteristicShear_Twin: '//trim(structure)) end select enddo mySystems enddo myFamilies @@ -2175,8 +1400,7 @@ end function lattice_characteristicShear_Twin !-------------------------------------------------------------------------------------------------- -!> @brief Calculates rotated elasticity matrices for twinning -!> ToDo: Completely untested +!> @brief Rotated elasticity matrices for twinning in 66-vector notation !-------------------------------------------------------------------------------------------------- function lattice_C66_twin(Ntwin,C66,structure,CoverA) use IO, only: & @@ -2184,46 +1408,52 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) use math, only: & INRAD, & math_axisAngleToR, & - math_Mandel3333to66, & - math_Mandel66to3333, & + math_sym3333to66, & + math_66toSym3333, & math_rotate_forward3333 implicit none integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(6,6), intent(in) :: C66 - real(pReal), intent(in) :: cOverA - real(pReal), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin + real(pReal), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin - real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem + real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem - real(pReal), dimension(3,3) :: R + real(pReal), dimension(3,3) :: R integer(pInt) :: i + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_C66_twin: '//trim(structure)) - select case(structure) + select case(structure(1:3)) case('fcc') - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,LATTICE_FCC_SYSTEMTWIN,structure,cOverA) + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,LATTICE_FCC_SYSTEMTWIN,& + trim(structure),0.0_pReal) case('bcc') - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMTWIN,structure,cOverA) - case('hex','hexagonal') !ToDo: "No alias policy": long or short? - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,'hex',cOverA) + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMTWIN,& + trim(structure),0.0_pReal) + case('hex') + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,& + 'hex',cOverA) case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_C66_twin)') + call IO_error(137_pInt,ext_msg='lattice_C66_twin: '//trim(structure)) end select + do i = 1, sum(Ntwin) R = math_axisAngleToR(coordinateSystem(1:3,2,i), 180.0_pReal * INRAD) ! ToDo: Why always 180 deg? - lattice_C66_twin(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(math_Mandel66to3333(C66),R)) + lattice_C66_twin(1:6,1:6,i) = math_sym3333to66(math_rotate_forward3333(math_66toSym3333(C66),R)) enddo - -end function +end function lattice_C66_twin !-------------------------------------------------------------------------------------------------- -!> @brief Calculates rotated elasticity matrices for transformation -!> ToDo: Completely untested and incomplete +!> @brief Rotated elasticity matrices for transformation in 66-vector notation +!> ToDo: Completely untested and incomplete and undocumented !-------------------------------------------------------------------------------------------------- -function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & - C_target66,structure_target) +function lattice_C66_trans(Ntrans,C_parent66,structure_target, & + CoverA_trans,a_bcc,a_fcc) use prec, only: & tol_math_check use IO, only: & @@ -2240,24 +1470,25 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & math_crossproduct implicit none - integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family - character(len=*), intent(in) :: & - structure_target, & !< lattice structure - structure_parent !< lattice structure - real(pReal), dimension(6,6), intent(in) :: C_parent66, C_target66 - real(pReal), dimension(6,6) :: C_bar66, C_target_unrotated66 - real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans - - real(pReal), dimension(3,3) :: R,B,U,Q,S,ss,sd,st - real(pReal), dimension(3) :: x,y,z - real(pReal) :: a_bcc, a_fcc, CoverA_trans + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + character(len=*), intent(in) :: & + structure_target !< lattice structure + real(pReal), dimension(6,6), intent(in) :: C_parent66 + real(pReal), dimension(6,6) :: C_bar66, C_target_unrotated66 + real(pReal), dimension(3,3,3,3) :: C_target_unrotated + real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans + real(pReal), dimension(3,3,sum(Ntrans)) :: Q,S + real(pReal) :: a_bcc, a_fcc, CoverA_trans integer(pInt) :: i - if (trim(structure_parent) /= 'hex') write(6,*) "Mist" + if (len_trim(structure_target) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_C66_trans (target): '//trim(structure_target)) + !ToDo: add checks for CoverA_trans,a_fcc,a_bcc + !-------------------------------------------------------------------------------------------------- ! elasticity matrix of the target phase in cube orientation - if (trim(structure_target) == 'hex') then + if (structure_target(1:3) == 'hex') then C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pReal*C_parent66(4,4))/2.0_pReal C_bar66(1,2) = (C_parent66(1,1) + 5.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/6.0_pReal C_bar66(3,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) + 4.0_pReal*C_parent66(4,4))/3.0_pReal @@ -2272,75 +1503,34 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & C_target_unrotated66(3,3) = C_bar66(3,3) C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2.0_pReal/(0.5_pReal*(C_bar66(1,1) - C_bar66(1,2))) C_target_unrotated66 = lattice_symmetrizeC66(LATTICE_HEX_ID,C_target_unrotated66) - elseif (trim(structure_target) == 'bcc') then + elseif (structure_target(1:3) == 'bcc') then C_target_unrotated66 = C_parent66 else - write(6,*) "Mist" + call IO_error(137_pInt,ext_msg='lattice_C66_trans (target): '//trim(structure_target)) endif + do i = 1_pInt, 6_pInt if (abs(C_target_unrotated66(i,i)) 0.0_pReal) .and. (a_bcc > 0.0_pReal)) then - U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) + & - (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) + & - (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal) - else BainDeformation - U = 0.0_pReal - endif BainDeformation - Q = math_mul33x33(R,B) - S = math_mul33x33(R,U) - MATH_I3 - enddo - elseif (trim(structure_target) == 'bcc') then - ss = MATH_I3 - ss(1,3) = sqrt(0.125_pReal) - sd = MATH_I3 - if (CoverA_trans > 1.0_pReal .and. CoverA_trans < 2.0_pReal) then - sd(3,3) = CoverA_trans/sqrt(8.0_pReal/3.0_pReal) - endif - st = math_mul33x33(sd,ss) - do i = 1_pInt,sum(Ntrans)!!!!!!!!!!!!!! NEED TO BE FIXED - R(1:3,1) = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) - R(1:3,3) = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) - R(1:3,2) = -math_crossproduct(R(1:3,1),R(1:3,3)) - Q = R - S = math_mul33x33(R, math_mul33x33(st, transpose(R))) - MATH_I3 - ! trs(i) = lattice_fccTohex_shearTrans(i) - enddo - else - write(6,*) "Mist" - endif - + C_target_unrotated = math_Mandel66to3333(C_target_unrotated66) + call buildTransformationSystem(Q,S,Ntrans,CoverA_trans,a_fcc,a_bcc) do i = 1, sum(Ntrans) -! R = math_axisAngleToR(coordinateSystem(1:3,2,i), 180.0_pReal * INRAD) ! ToDo: Why always 180 deg? -! lattice_C66_trans(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(math_Mandel66to3333(C66),R)) + lattice_C66_trans(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(C_target_unrotated,Q(1:3,1:3,i))) enddo -end function - +end function lattice_C66_trans !-------------------------------------------------------------------------------------------------- -!> @brief Non-schmid tensor -!> ToDo: Clean description needed -! Schmid matrices with non-Schmid contributions according to Koester_etal2012, Acta Materialia 60 (2012) -! 3894–3901, eq. (17) ("n1" is replaced by either "np" or "nn" according to either positive or negative slip direction) -! "np" and "nn" according to Gröger_etal2008, Acta Materialia 56 (2008) 5412–5425, table 1 -! (corresponds to their "n1" for positive and negative slip direction respectively) +!> @brief Non-schmid projections for bcc with up to 6 coefficients +! Koester et al. 2012, Acta Materialia 60 (2012) 3894–3901, eq. (17) +! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1 !-------------------------------------------------------------------------------------------------- function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix) + use IO, only: & + IO_error use math, only: & INRAD, & math_tensorproduct33, & @@ -2348,21 +1538,22 @@ function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSc math_mul33x3, & math_axisAngleToR implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients - integer(pInt), intent(in) :: sense !< sense (-1,+1) + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections + integer(pInt), intent(in) :: sense !< sense (-1,+1) + real(pReal), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix - real(pReal), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix - - real(pReal), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem - real(pReal), dimension(:), allocatable :: direction - real(pReal), dimension(:), allocatable :: normal,np + real(pReal), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem !< coordinate system of slip system + real(pReal), dimension(:), allocatable :: & + direction, normal, np integer(pInt) :: i - if (abs(sense) /= 1_pInt) write(6,*) 'mist' - coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMSLIP,'bcc',0.0_pReal) - coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal) - nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc',0.0_pReal) + if (abs(sense) /= 1_pInt) call IO_error(0_pInt,ext_msg='lattice_nonSchmidMatrix') + + coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMSLIP,& + 'bcc',0.0_pReal) + coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal) ! convert unidirectional coordinate system + nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc',0.0_pReal) ! Schmid contribution do i = 1_pInt,sum(Nslip) direction = coordinateSystem(1:3,1,i) @@ -2386,8 +1577,8 @@ end function lattice_nonSchmidMatrix !-------------------------------------------------------------------------------------------------- -!> @brief Populates slip-slip interaction matrix -!> details: only active slip systems are considered +!> @brief Slip-slip interaction matrix +!> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result(interactionMatrix) use IO, only: & @@ -2395,41 +1586,41 @@ function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result( implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values slip-slip + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Nslip),sum(Nslip)) :: interactionMatrix integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt), dimension(:,:), allocatable :: interactionTypes - select case(structure) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipSlip: '//trim(structure)) + + select case(structure(1:3)) case('fcc') interactionTypes = LATTICE_FCC_INTERACTIONSLIPSLIP NslipMax = LATTICE_FCC_NSLIPSYSTEM case('bcc') interactionTypes = LATTICE_BCC_INTERACTIONSLIPSLIP NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex') interactionTypes = LATTICE_HEX_INTERACTIONSLIPSLIP NslipMax = LATTICE_HEX_NSLIPSYSTEM case('bct') interactionTypes = LATTICE_BCT_INTERACTIONSLIPSLIP NslipMax = LATTICE_BCT_NSLIPSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (slip slip interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipSlip: '//trim(structure)) end select - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes) end function lattice_interaction_SlipSlip !-------------------------------------------------------------------------------------------------- -!> @brief Populates twin-twin interaction matrix -!> details: only active twin systems are considered +!> @brief Twin-twin interaction matrix +!> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result(interactionMatrix) use IO, only: & @@ -2437,151 +1628,142 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( implicit none integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin + real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Ntwin),sum(Ntwin)) :: interactionMatrix integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt), dimension(:,:), allocatable :: interactionTypes - select case(structure) + integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NTWIN), parameter :: & + FCC_INTERACTIONTWINTWIN = reshape(int( [& + 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> twin + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 2,2,2,1,1,1,2,2,2,2,2,2, & ! v twin + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1 & + ],pInt),shape(FCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin-twin interaction types for fcc + + integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NTWIN), parameter :: & + BCC_INTERACTIONTWINTWIN = reshape(int( [& + 1,3,3,3,3,3,3,2,3,3,2,3, & ! ---> twin + 3,1,3,3,3,3,2,3,3,3,3,2, & ! | + 3,3,1,3,3,2,3,3,2,3,3,3, & ! | + 3,3,3,1,2,3,3,3,3,2,3,3, & ! v twin + 3,3,3,2,1,3,3,3,3,2,3,3, & + 3,3,2,3,3,1,3,3,2,3,3,3, & + 3,2,3,3,3,3,1,3,3,3,3,2, & + 2,3,3,3,3,3,3,1,3,3,2,3, & + 3,3,2,3,3,2,3,3,1,3,3,3, & + 3,3,3,2,2,3,3,3,3,1,3,3, & + 2,3,3,3,3,3,3,2,3,3,1,3, & + 3,2,3,3,3,3,2,3,3,3,3,1 & + ],pInt),shape(BCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin-twin interaction types for bcc + !< 1: self interaction + !< 2: collinear interaction + !< 3: other interaction + integer(pInt), dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NTWIN), parameter :: & + HEX_INTERACTIONTWINTWIN = reshape(int( [& + 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! ---> twin + 2, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | + 2, 2, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | + 2, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! v twin + 2, 2, 2, 2, 1, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & + 2, 2, 2, 2, 2, 1, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & + ! + 6, 6, 6, 6, 6, 6, 4, 5, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 4, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 4, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 4, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 4, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 4, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + ! + 12,12,12,12,12,12, 11,11,11,11,11,11, 9,10,10,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10, 9,10,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10, 9,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10, 9,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10, 9,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10,10, 9, 15,15,15,15,15,15, & + ! + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 16,17,17,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,16,17,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,16,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & + ],pInt),shape(HEX_INTERACTIONTWINTWIN),order=[2,1]) !< Twin-twin interaction types for hex + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinTwin: '//trim(structure)) + + select case(structure(1:3)) case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONTWINTWIN + interactionTypes = FCC_INTERACTIONTWINTWIN NtwinMax = LATTICE_FCC_NTWINSYSTEM case('bcc') - interactionTypes = LATTICE_BCC_INTERACTIONTWINTWIN + interactionTypes = BCC_INTERACTIONTWINTWIN NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? - interactionTypes = LATTICE_HEX_INTERACTIONTWINTWIN + case('hex') + interactionTypes = HEX_INTERACTIONTWINTWIN NtwinMax = LATTICE_HEX_NTWINSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (twin twin interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinTwin: '//trim(structure)) end select - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes) end function lattice_interaction_TwinTwin !-------------------------------------------------------------------------------------------------- -!> @brief Populates slip-twin interaction matrix -!> details: only active slip and twin systems are considered +!> @brief Trans-trans interaction matrix +!> details only active trans systems are considered !-------------------------------------------------------------------------------------------------- -function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix) +function lattice_interaction_TransTrans(Ntrans,interactionValues,structure) result(interactionMatrix) use IO, only: & IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: interactionMatrix - - integer(pInt), dimension(:), allocatable :: NslipMax - integer(pInt), dimension(:), allocatable :: NtwinMax - integer(pInt), dimension(:,:), allocatable :: interactionTypes - - select case(structure) - case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONSLIPTWIN - NslipMax = LATTICE_FCC_NSLIPSYSTEM - NtwinMax = LATTICE_FCC_NTWINSYSTEM - case('bcc') - interactionTypes = LATTICE_BCC_INTERACTIONSLIPTWIN - NslipMax = LATTICE_BCC_NSLIPSYSTEM - NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? - interactionTypes = LATTICE_HEX_INTERACTIONSLIPTWIN - NslipMax = LATTICE_HEX_NSLIPSYSTEM - NtwinMax = LATTICE_HEX_NTWINSYSTEM - case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (slip twin interaction)') - end select - - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - - interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes) - -end function lattice_interaction_SlipTwin - - -!-------------------------------------------------------------------------------------------------- -!> @brief Populates twin-slip interaction matrix -!> details: only active twin and slip systems are considered -!-------------------------------------------------------------------------------------------------- -function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: interactionMatrix - - integer(pInt), dimension(:), allocatable :: NslipMax - integer(pInt), dimension(:), allocatable :: NtwinMax - integer(pInt), dimension(:,:), allocatable :: interactionTypes - - select case(structure) - case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONTWINSLIP - NtwinMax = LATTICE_FCC_NTWINSYSTEM - NslipMax = LATTICE_FCC_NSLIPSYSTEM - case('bcc') - interactionTypes = LATTICE_BCC_INTERACTIONTWINSLIP - NtwinMax = LATTICE_BCC_NTWINSYSTEM - NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? - interactionTypes = LATTICE_HEX_INTERACTIONTWINSLIP - NtwinMax = LATTICE_HEX_NTWINSYSTEM - NslipMax = LATTICE_HEX_NSLIPSYSTEM - case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)') - end select - - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - - interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes) - -end function lattice_interaction_TwinSlip - - -!-------------------------------------------------------------------------------------------------- -!> @brief Populates trans-trans interaction matrix -!> details: only active transformation systems are considered -!-------------------------------------------------------------------------------------------------- -function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targetStructure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin - character(len=*), intent(in) :: & - structure, & !< lattice structure of parent crystal - targetStructure !< lattice structure of transformed crystal + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active trans systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction + character(len=*), intent(in) :: structure !< lattice structure (parent crystal) real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: interactionMatrix integer(pInt), dimension(:), allocatable :: NtransMax integer(pInt), dimension(:,:), allocatable :: interactionTypes - if (trim(structure) == 'fcc' .and. trim(targetStructure) == 'hex') then - interactionTypes = lattice_fccToHex_interactionTransTrans - NtransMax = lattice_fcc_Ntrans - else - call IO_error(132_pInt,ext_msg=trim(structure)//' => '//trim(targetStructure)) - end if + integer(pInt), dimension(LATTICE_FCC_NTRANS,LATTICE_FCC_NTRANS), parameter :: & + FCC_INTERACTIONTRANSTRANS = reshape(int( [& + 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> trans + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 2,2,2,1,1,1,2,2,2,2,2,2, & ! v trans + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1 & + ],pInt),shape(FCC_INTERACTIONTRANSTRANS),order=[2,1]) !< Trans-trans interaction types for fcc - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_TransTrans: '//trim(structure)) + + if(structure(1:3) == 'fcc') then + interactionTypes = FCC_INTERACTIONTRANSTRANS + NtransMax = LATTICE_FCC_NTRANSSYSTEM + else + call IO_error(137_pInt,ext_msg='lattice_interaction_TransTrans: '//trim(structure)) + end if interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) @@ -2589,7 +1771,292 @@ end function lattice_interaction_TransTrans !-------------------------------------------------------------------------------------------------- -!> @brief Calculates Schmid matrix for active slip systems +!> @brief Slip-twin interaction matrix +!> details only active slip and twin systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix) + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family + Ntwin !< number of active twin systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-twin interaction + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: interactionMatrix + + integer(pInt), dimension(:), allocatable :: NslipMax, & + NtwinMax + integer(pInt), dimension(:,:), allocatable :: interactionTypes + + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NTWIN), parameter :: & + FCC_INTERACTIONSLIPTWIN = reshape(int( [& + 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> twin + 1,1,1,3,3,3,3,3,3,2,2,2, & ! | + 1,1,1,2,2,2,3,3,3,3,3,3, & ! | + 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip + 3,3,3,1,1,1,2,2,2,3,3,3, & + 2,2,2,1,1,1,3,3,3,3,3,3, & + 2,2,2,3,3,3,1,1,1,3,3,3, & + 3,3,3,2,2,2,1,1,1,3,3,3, & + 3,3,3,3,3,3,1,1,1,2,2,2, & + 3,3,3,2,2,2,3,3,3,1,1,1, & + 2,2,2,3,3,3,3,3,3,1,1,1, & + 3,3,3,3,3,3,2,2,2,1,1,1, & + + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4 & + ],pInt),shape(FCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip-twin interaction types for fcc + !< 1: coplanar interaction + !< 2: screw trace between slip system and twin habit plane (easy cross slip) + !< 3: other interaction + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NTWIN), parameter :: & + BCC_INTERACTIONSLIPTWIN = reshape(int( [& + 3,3,3,2,2,3,3,3,3,2,3,3, & ! ---> twin + 3,3,2,3,3,2,3,3,2,3,3,3, & ! | + 3,2,3,3,3,3,2,3,3,3,3,2, & ! | + 2,3,3,3,3,3,3,2,3,3,2,3, & ! v slip + 2,3,3,3,3,3,3,2,3,3,2,3, & + 3,3,2,3,3,2,3,3,2,3,3,3, & + 3,2,3,3,3,3,2,3,3,3,3,2, & + 3,3,3,2,2,3,3,3,3,2,3,3, & + 2,3,3,3,3,3,3,2,3,3,2,3, & + 3,3,3,2,2,3,3,3,3,2,3,3, & + 3,2,3,3,3,3,2,3,3,3,3,2, & + 3,3,2,3,3,2,3,3,2,3,3,3, & + ! + 1,3,3,3,3,3,3,2,3,3,2,3, & + 3,1,3,3,3,3,2,3,3,3,3,2, & + 3,3,1,3,3,2,3,3,2,3,3,3, & + 3,3,3,1,2,3,3,3,3,2,3,3, & + 3,3,3,2,1,3,3,3,3,2,3,3, & + 3,3,2,3,3,1,3,3,2,3,3,3, & + 3,2,3,3,3,3,1,3,3,3,3,2, & + 2,3,3,3,3,3,3,1,3,3,2,3, & + 3,3,2,3,3,2,3,3,1,3,3,3, & + 3,3,3,2,2,3,3,3,3,1,3,3, & + 2,3,3,3,3,3,3,2,3,3,1,3, & + 3,2,3,3,3,3,2,3,3,3,3,1 & + ],pInt),shape(BCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip-twin interaction types for bcc + !< 1: coplanar interaction + !< 2: screw trace between slip system and twin habit plane (easy cross slip) + !< 3: other interaction + integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NTWIN), parameter :: & + HEX_INTERACTIONSLIPTWIN = reshape(int( [& + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! --> twin + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + ! v + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & + ! + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + ! + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + ! + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + ! + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & + ! + ],pInt),shape(HEX_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip-twin interaction types for hex + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTwin: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONSLIPTWIN + NslipMax = LATTICE_FCC_NSLIPSYSTEM + NtwinMax = LATTICE_FCC_NTWINSYSTEM + case('bcc') + interactionTypes = BCC_INTERACTIONSLIPTWIN + NslipMax = LATTICE_BCC_NSLIPSYSTEM + NtwinMax = LATTICE_BCC_NTWINSYSTEM + case('hex') + interactionTypes = HEX_INTERACTIONSLIPTWIN + NslipMax = LATTICE_HEX_NSLIPSYSTEM + NtwinMax = LATTICE_HEX_NTWINSYSTEM + case default + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTwin: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes) + +end function lattice_interaction_SlipTwin + + +!-------------------------------------------------------------------------------------------------- +!> @brief Slip-trans interaction matrix +!> details only active slip and trans systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix) + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family + Ntrans !< number of active trans systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-trans interaction + character(len=*), intent(in) :: & + structure !< lattice structure (parent crystal) + real(pReal), dimension(sum(Nslip),sum(Ntrans)) :: interactionMatrix + + integer(pInt), dimension(:), allocatable :: NslipMax, & + NtransMax + integer(pInt), dimension(:,:), allocatable :: interactionTypes + + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_fcc_Ntrans), parameter :: & + FCC_INTERACTIONSLIPTRANS = reshape(int( [& + 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> trans + 1,1,1,3,3,3,3,3,3,2,2,2, & ! | + 1,1,1,2,2,2,3,3,3,3,3,3, & ! | + 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip + 3,3,3,1,1,1,2,2,2,3,3,3, & + 2,2,2,1,1,1,3,3,3,3,3,3, & + 2,2,2,3,3,3,1,1,1,3,3,3, & + 3,3,3,2,2,2,1,1,1,3,3,3, & + 3,3,3,3,3,3,1,1,1,2,2,2, & + 3,3,3,2,2,2,3,3,3,1,1,1, & + 2,2,2,3,3,3,3,3,3,1,1,1, & + 3,3,3,3,3,3,2,2,2,1,1,1, & + + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4 & + ],pInt),shape(FCC_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip-trans interaction types for fcc + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTrans: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONSLIPTRANS + NslipMax = LATTICE_FCC_NSLIPSYSTEM + NtransMax = LATTICE_FCC_NTRANSSYSTEM + case default + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTrans: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Nslip,Ntrans,NslipMax,NtransMax,interactionValues,interactionTypes) + +end function lattice_interaction_SlipTrans + + +!-------------------------------------------------------------------------------------------------- +!> @brief Twin-slip interaction matrix +!> details only active twin and slip systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix) + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family + Nslip !< number of active slip systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: interactionMatrix + + integer(pInt), dimension(:), allocatable :: NtwinMax, & + NslipMax + integer(pInt), dimension(:,:), allocatable :: interactionTypes + + integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter :: & + FCC_INTERACTIONTWINSLIP = 1_pInt !< Twin-Slip interaction types for fcc + + integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter :: & + BCC_INTERACTIONTWINSLIP = 1_pInt !< Twin-slip interaction types for bcc + + integer(pInt), dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NSLIP), parameter :: & + HEX_INTERACTIONTWINSLIP = reshape(int( [& + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! --> slip + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! v + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! twin + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & + ! + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + ! + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + ! + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & + ],pInt),shape(HEX_INTERACTIONTWINSLIP),order=[2,1]) !< Twin-twin interaction types for hex + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinSlip: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONTWINSLIP + NtwinMax = LATTICE_FCC_NTWINSYSTEM + NslipMax = LATTICE_FCC_NSLIPSYSTEM + case('bcc') + interactionTypes = BCC_INTERACTIONTWINSLIP + NtwinMax = LATTICE_BCC_NTWINSYSTEM + NslipMax = LATTICE_BCC_NSLIPSYSTEM + case('hex') + interactionTypes = HEX_INTERACTIONTWINSLIP + NtwinMax = LATTICE_HEX_NTWINSYSTEM + NslipMax = LATTICE_HEX_NSLIPSYSTEM + case default + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinSlip: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes) + +end function lattice_interaction_TwinSlip + + +!-------------------------------------------------------------------------------------------------- +!> @brief Schmid matrix for slip +!> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) use prec, only: & @@ -2601,31 +2068,34 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) math_tensorproduct33 implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(3,3,sum(Nslip)) :: SchmidMatrix + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure real(pReal), intent(in) :: cOverA + real(pReal), dimension(3,3,sum(Nslip)) :: SchmidMatrix real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem real(pReal), dimension(:,:), allocatable :: slipSystems - integer(pInt), dimension(:), allocatable :: NslipMax + integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt) :: i + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) - select case(structure) + select case(structure(1:3)) case('fcc') NslipMax = LATTICE_FCC_NSLIPSYSTEM slipSystems = LATTICE_FCC_SYSTEMSLIP case('bcc') NslipMax = LATTICE_BCC_NSLIPSYSTEM slipSystems = LATTICE_BCC_SYSTEMSLIP - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex') NslipMax = LATTICE_HEX_NSLIPSYSTEM slipSystems = LATTICE_HEX_SYSTEMSLIP case('bct') NslipMax = LATTICE_BCT_NSLIPSYSTEM slipSystems = LATTICE_BCT_SYSTEMSLIP case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_slip)') + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) end select if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & @@ -2645,7 +2115,8 @@ end function lattice_SchmidMatrix_slip !-------------------------------------------------------------------------------------------------- -!> @brief Calculates Schmid matrix for active twin systems +!> @brief Schmid matrix for twinning +!> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) use prec, only: & @@ -2657,35 +2128,38 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) math_tensorproduct33 implicit none - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - character(len=*), intent(in) :: structure !< lattice structure + integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio real(pReal), dimension(3,3,sum(Ntwin)) :: SchmidMatrix - real(pReal), intent(in) :: cOverA real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem real(pReal), dimension(:,:), allocatable :: twinSystems - integer(pInt), dimension(:), allocatable :: NtwinMax + integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt) :: i - select case(structure) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) + + select case(structure(1:3)) case('fcc') NtwinMax = LATTICE_FCC_NTWINSYSTEM twinSystems = LATTICE_FCC_SYSTEMTWIN case('bcc') NtwinMax = LATTICE_BCC_NTWINSYSTEM twinSystems = LATTICE_BCC_SYSTEMTWIN - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex') NtwinMax = LATTICE_HEX_NTWINSYSTEM twinSystems = LATTICE_HEX_SYSTEMTWIN case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_twin)') + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) end select if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0_pInt)) & call IO_error(145_pInt,ext_msg='Ntwin '//trim(structure)) if (any(Ntwin < 0_pInt)) & call IO_error(144_pInt,ext_msg='Ntwin '//trim(structure)) - + coordinateSystem = buildCoordinateSystem(Ntwin,NtwinMax,twinSystems,structure,cOverA) do i = 1, sum(Ntwin) @@ -2697,11 +2171,162 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) end function lattice_SchmidMatrix_twin +!-------------------------------------------------------------------------------------------------- +!> @brief Schmid matrix for twinning +!> details only active twin systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix) + use prec, only: & + tol_math_check + use IO, only: & + IO_error + use math, only: & + math_trace33, & + math_tensorproduct33 + + implicit none + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,3,sum(Ntrans)) :: SchmidMatrix + + character(len=*), intent(in) :: & + structure_target !< lattice structure + + real(pReal), dimension(3,3,sum(Ntrans)) :: devNull + real(pReal) :: a_bcc, a_fcc + + if (len_trim(structure_target) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) + if (structure_target(1:3) /= 'bcc' .and. structure_target(1:3) /= 'hex') & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) + + !ToDo: add checks for CoverA_trans,a_fcc,a_bcc + + call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA,a_fcc,a_bcc) + + end function lattice_SchmidMatrix_trans + + +!-------------------------------------------------------------------------------------------------- +!> @brief Schmid matrix for cleavage +!> details only active cleavage systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) + use math, only: & + math_tensorproduct33 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix + + real(pReal), dimension(3,3,sum(Ncleavage)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: cleavageSystems + integer(pInt), dimension(:), allocatable :: NcleavageMax + integer(pInt) :: i + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) + + select case(structure(1:3)) + case('iso') + NcleavageMax = LATTICE_ISO_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_ISO_SYSTEMCLEAVAGE + case('ort') + NcleavageMax = LATTICE_ORT_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_ORT_SYSTEMCLEAVAGE + case('fcc') + NcleavageMax = LATTICE_FCC_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_FCC_SYSTEMCLEAVAGE + case('bcc') + NcleavageMax = LATTICE_BCC_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_BCC_SYSTEMCLEAVAGE + case('hex') + NcleavageMax = LATTICE_HEX_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_HEX_SYSTEMCLEAVAGE + case default + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) + end select + + if (any(NcleavageMax(1:size(Ncleavage)) - Ncleavage < 0_pInt)) & + call IO_error(145_pInt,ext_msg='Ncleavage '//trim(structure)) + if (any(Ncleavage < 0_pInt)) & + call IO_error(144_pInt,ext_msg='Ncleavage '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA) + + do i = 1, sum(Ncleavage) + SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) + enddo + +end function lattice_SchmidMatrix_cleavage + + +!-------------------------------------------------------------------------------------------------- +!> @brief Forest projection (for edge dislocations) +!-------------------------------------------------------------------------------------------------- +function lattice_forestProjection(Nslip,structure,cOverA) result(projection) + use math, only: & + math_mul3x3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: slipSystems + integer(pInt), dimension(:), allocatable :: NslipMax + integer(pInt) :: i, j + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + NslipMax = LATTICE_FCC_NSLIPSYSTEM + slipSystems = LATTICE_FCC_SYSTEMSLIP + case('bcc') + NslipMax = LATTICE_BCC_NSLIPSYSTEM + slipSystems = LATTICE_BCC_SYSTEMSLIP + case('hex') + NslipMax = LATTICE_HEX_NSLIPSYSTEM + slipSystems = LATTICE_HEX_SYSTEMSLIP + case('bct') + NslipMax = LATTICE_BCT_NSLIPSYSTEM + slipSystems = LATTICE_BCT_SYSTEMSLIP + case default + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + end select + + if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & + call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) + if (any(Nslip < 0_pInt)) & + call IO_error(144_pInt,ext_msg='Nslip '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + + do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) + projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) + enddo; enddo + +end function lattice_forestProjection + + !-------------------------------------------------------------------------------------------------- !> @brief Populates reduced interaction matrix !-------------------------------------------------------------------------------------------------- -pure function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) - +function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) + use IO, only: & + IO_error implicit none integer(pInt), dimension(:), intent(in) :: & activeA, & !< number of active systems as specified in material.config @@ -2709,7 +2334,7 @@ pure function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) maxA, & !< number of maximum available systems maxB !< number of maximum available systems real(pReal), dimension(:), intent(in) :: values !< interaction values - integer(pInt), dimension(:,:), intent(in) :: matrix !< full interaction matrix + integer(pInt), dimension(:,:), intent(in) :: matrix !< complete interaction matrix real(pReal), dimension(sum(activeA),sum(activeB)) :: buildInteraction integer(pInt) :: & @@ -2723,6 +2348,8 @@ pure function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) otherFamilies: do of = 1_pInt,size(activeB,1) index_otherFamily = sum(activeB(1:of-1_pInt)) otherSystems: do os = 1_pInt,activeB(of) + if(matrix(sum(maxA(1:mf-1))+ms, sum(maxB(1:of-1))+os) > size(values)) & + call IO_error(138,ext_msg='buildInteraction') buildInteraction(index_myFamily+ms,index_otherFamily+os) = & values(matrix(sum(maxA(1:mf-1))+ms, sum(maxB(1:of-1))+os)) enddo otherSystems; enddo otherFamilies; @@ -2734,16 +2361,18 @@ end function buildInteraction !-------------------------------------------------------------------------------------------------- !> @brief build a local coordinate system in a slip, twin, trans, cleavage system -!> @details: Order: Direction, plane (normal), and common perpendicular +!> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- -function buildCoordinateSystem(active,maximum,system,structure,cOverA) +function buildCoordinateSystem(active,complete,system,structure,cOverA) + use IO, only: & + IO_error use math, only: & math_crossproduct implicit none integer(pInt), dimension(:), intent(in) :: & active, & - maximum + complete real(pReal), dimension(:,:), intent(in) :: & system character(len=*), intent(in) :: & @@ -2756,49 +2385,195 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA) real(pReal), dimension(3) :: & direction, normal integer(pInt) :: & - i, & !< index in reduced matrix - j, & !< index in full matrix + a, & !< index of active system + c, & !< index in complete system matrix f, & !< index of my family s !< index of my system in current family - i = 0_pInt + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='buildCoordinateSystem: '//trim(structure)) + if (trim(structure(1:3)) == 'bct' .and. cOverA > 2.0_pReal) & + call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) + if (trim(structure(1:3)) == 'hex' .and. (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal)) & + call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) + + a = 0_pInt activeFamilies: do f = 1_pInt,size(active,1) activeSystems: do s = 1_pInt,active(f) - i = i + 1_pInt - j = sum(maximum(1:f-1))+s + a = a + 1_pInt + c = sum(complete(1:f-1))+s - select case(trim(structure)) + select case(trim(structure(1:3))) + + case ('fcc','bcc','iso','ort','bct') + direction = system(1:3,c) + normal = system(4:6,c) - case ('fcc','bcc') - direction = system(1:3,j) - normal = system(4:6,j) - case ('hex') - !ToDo: check c/a ratio - ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) - direction = [ system(1,j)*1.5_pReal, & - (system(1,j)+2.0_pReal*system(2,j))*sqrt(0.75_pReal), & - system(4,j)*CoverA ] + direction = [ system(1,c)*1.5_pReal, & + (system(1,c)+2.0_pReal*system(2,c))*sqrt(0.75_pReal), & + system(4,c)*cOverA ] ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) + normal = [ system(5,c), & + (system(5,c)+2.0_pReal*system(6,c))/sqrt(3.0_pReal), & + system(8,c)/cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - normal = [ system(5,j), & - (system(5,j)+2.0_pReal*system(6,j))/ sqrt(3.0_pReal), & - system(8,j)/CoverA ] - - case ('bct') - !ToDo: check c/a ratio - direction = [system(1:2,j),system(3,i)*CoverA] - normal = [system(4:5,j),system(6,i)/CoverA] + case default + call IO_error(137_pInt,ext_msg='buildCoordinateSystem: '//trim(structure)) end select - buildCoordinateSystem(1:3,1,i) = direction/norm2(direction) - buildCoordinateSystem(1:3,2,i) = normal/norm2(normal) - buildCoordinateSystem(1:3,3,i) = math_crossproduct(direction,normal) + buildCoordinateSystem(1:3,1,a) = direction/norm2(direction) + buildCoordinateSystem(1:3,2,a) = normal/norm2(normal) + buildCoordinateSystem(1:3,3,a) = math_crossproduct(buildCoordinateSystem(1:3,1,a),& + buildCoordinateSystem(1:3,2,a)) enddo activeSystems enddo activeFamilies end function buildCoordinateSystem + +!-------------------------------------------------------------------------------------------------- +!> @brief Helper function to define transformation systems +! Needed to calculate Schmid matrix and rotated stiffness matrices. +! @details: set c/a = 0.0 for fcc -> bcc transformation +! set a_bcc = 0.0 for fcc -> hex transformation +!-------------------------------------------------------------------------------------------------- +subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) + use prec, only: & + dEq0 + use math, only: & + math_crossproduct, & + math_tensorproduct33, & + math_mul33x33, & + math_mul33x3, & + math_axisAngleToR, & + INRAD, & + MATH_I3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: & + Ntrans + real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: & + Q, & !< Total rotation: Q = R*B + S !< Eigendeformation tensor for phase transformation + real(pReal), intent(in) :: & + cOverA, & !< c/a for target hex structure + a_bcc, & !< lattice parameter a for target bcc structure + a_fcc !< lattice parameter a for parent fcc structure + + real(pReal), dimension(3,3) :: & + R, & !< Pitsch rotation + U, & !< Bain deformation + B, & !< Rotation of fcc to Bain coordinate system + ss, sd + real(pReal), dimension(3) :: & + x, y, z + integer(pInt) :: & + i + real(pReal), dimension(3+3,LATTICE_FCC_NTRANS), parameter :: & + LATTICE_FCCTOHEX_SYSTEMTRANS = reshape(real( [& + -2, 1, 1, 1, 1, 1, & + 1,-2, 1, 1, 1, 1, & + 1, 1,-2, 1, 1, 1, & + 2,-1, 1, -1,-1, 1, & + -1, 2, 1, -1,-1, 1, & + -1,-1,-2, -1,-1, 1, & + -2,-1,-1, 1,-1,-1, & + 1, 2,-1, 1,-1,-1, & + 1,-1, 2, 1,-1,-1, & + 2, 1,-1, -1, 1,-1, & + -1,-2,-1, -1, 1,-1, & + -1, 1, 2, -1, 1,-1 & + ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) + real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_SYSTEMTRANS = reshape([& + 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) + 0.0, 1.0, 0.0, -10.26, & + 0.0, 0.0, 1.0, 10.26, & + 0.0, 0.0, 1.0, -10.26, & + 1.0, 0.0, 0.0, 10.26, & + 1.0, 0.0, 0.0, -10.26, & + 0.0, 0.0, 1.0, 10.26, & + 0.0, 0.0, 1.0, -10.26, & + 1.0, 0.0, 0.0, 10.26, & + 1.0, 0.0, 0.0, -10.26, & + 0.0, 1.0, 0.0, 10.26, & + 0.0, 1.0, 0.0, -10.26 & + ],shape(LATTICE_FCCTOBCC_SYSTEMTRANS)) + + integer(pInt), dimension(9,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_BAINVARIANT = reshape(int( [& + 1, 0, 0, 0, 1, 0, 0, 0, 1, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0 & + ],pInt),shape(LATTICE_FCCTOBCC_BAINVARIANT)) + + real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_BAINROT = reshape([& + 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant + 1.0, 0.0, 0.0, 45.0, & + 1.0, 0.0, 0.0, 45.0, & + 1.0, 0.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0 & + ],shape(LATTICE_FCCTOBCC_BAINROT)) + + if (size(Ntrans) < 1_pInt .or. size(Ntrans) > 1_pInt) print*, 'mist' ! ToDo + + if (a_bcc > 0.0_pReal .and. dEq0(cOverA)) then ! fcc -> bcc transformation + do i = 1_pInt,sum(Ntrans) + R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & + lattice_fccTobcc_systemTrans(4,i)*INRAD) + B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & + lattice_fccTobcc_bainRot(4,i)*INRAD) + x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) + y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) + z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) + + U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) & + + (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) & + + (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal) + Q(1:3,1:3,i) = math_mul33x33(R,B) + S(1:3,1:3,i) = math_mul33x33(R,U) - MATH_I3 + enddo + elseif (cOverA > 0.0_pReal .and. dEq0(a_bcc)) then ! fcc -> hex transformation + ss = MATH_I3 + sd = MATH_I3 + ss(1,3) = sqrt(2.0_pReal)/4.0_pReal + if (cOverA > 1.0_pReal .and. cOverA < 2.0_pReal) & + sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal) + + do i = 1_pInt,sum(Ntrans) + x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) + z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) + y = -math_crossproduct(x,z) + Q(1:3,1,i) = x + Q(1:3,2,i) = y + Q(1:3,3,i) = z + S(1:3,1:3,i) = math_mul33x33(Q(1:3,1:3,i), math_mul33x33(math_mul33x33(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 ! ToDo: This is of interest for the Schmid matrix only + enddo + else + call IO_error(0_pInt) !ToDo: define error + endif + +end subroutine buildTransformationSystem + end module lattice diff --git a/src/material.f90 b/src/material.f90 index 8356f43c7..d12321235 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -918,7 +918,8 @@ end subroutine material_parseTexture !-------------------------------------------------------------------------------------------------- !> @brief allocates the plastic state of a phase !-------------------------------------------------------------------------------------------------- -subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState,& +subroutine material_allocatePlasticState(phase,NofMyPhase,& + sizeState,sizeDotState,sizeDeltaState,& Nslip,Ntwin,Ntrans) use numerics, only: & numerics_integrator2 => numerics_integrator ! compatibility hack @@ -936,9 +937,10 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState integer(pInt) :: numerics_integrator ! compatibility hack numerics_integrator = numerics_integrator2(1) ! compatibility hack - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition plasticState(phase)%Nslip = Nslip plasticState(phase)%Ntwin = Ntwin plasticState(phase)%Ntrans= Ntrans diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 94e07fc84..f987ee75b 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -28,8 +28,7 @@ module plastic_disloUCLA shearrate_ID, & accumulatedshear_ID, & mfp_ID, & - thresholdstress_ID, & - dipoledistance_ID + thresholdstress_ID end enum type, private :: tParameters @@ -73,7 +72,7 @@ module plastic_disloUCLA integer(kind(undefined_ID)), allocatable, dimension(:) :: & outputID !< ID of each post result output logical :: & - dipoleformation + dipoleFormation !< flag indicating consideration of dipole formation end type !< container type for internal constitutive parameters type, private :: tDisloUCLAState @@ -93,7 +92,7 @@ module plastic_disloUCLA !-------------------------------------------------------------------------------------------------- ! containers for parameters and state type(tParameters), allocatable, dimension(:), private :: param - type(tDisloUCLAState ), allocatable, dimension(:), private :: & + type(tDisloUCLAState), allocatable, dimension(:), private :: & dotState, & state type(tDisloUCLAdependentState), allocatable, dimension(:), private :: dependentState @@ -127,7 +126,6 @@ subroutine plastic_disloUCLA_init() debug_constitutive,& debug_levelBasic use math, only: & - math_mul3x3, & math_expand use IO, only: & IO_error, & @@ -148,8 +146,6 @@ subroutine plastic_disloUCLA_init() implicit none integer(pInt) :: & - index_myFamily, index_otherFamily, & - f,j,k,o, & Ninstance, & p, i, & NipcMyPhase, & @@ -164,7 +160,6 @@ subroutine plastic_disloUCLA_init() outputID character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs @@ -197,8 +192,6 @@ subroutine plastic_disloUCLA_init() dst => dependentState(phase_plasticityInstance(p)), & config => config_phase(p)) - structure = config%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! optional parameters that need to be defined prm%mu = lattice_mu(p) @@ -213,36 +206,41 @@ subroutine plastic_disloUCLA_init() prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - if(structure=='bcc') then - prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + 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_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) else - prm%nonSchmid_pos = prm%Schmid - prm%nonSchmid_neg = prm%Schmid + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid endif + prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - structure(1:3)) - prm%rho0 = config%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) - prm%rhoDip0 = config%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip)) - prm%v0 = config%getFloats('v0', requiredShape=shape(prm%Nslip)) - prm%burgers = config%getFloats('slipburgers', requiredShape=shape(prm%Nslip)) - prm%H0kp = config%getFloats('qedge', requiredShape=shape(prm%Nslip)) + config%getString('lattice_structure')) + prm%forestProjectionEdge = lattice_forestProjection(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%clambda = config%getFloats('clambdaslip', requiredShape=shape(prm%Nslip)) - prm%tau_Peierls = config%getFloats('tau_peierls', requiredShape=shape(prm%Nslip)) ! ToDo: Deprecated - prm%p = config%getFloats('p_slip', requiredShape=shape(prm%Nslip), & + prm%rho0 = config%getFloats('rhoedge0', requiredSize=size(prm%Nslip)) + prm%rhoDip0 = config%getFloats('rhoedgedip0', requiredSize=size(prm%Nslip)) + prm%v0 = config%getFloats('v0', requiredSize=size(prm%Nslip)) + prm%burgers = config%getFloats('slipburgers', requiredSize=size(prm%Nslip)) + prm%H0kp = config%getFloats('qedge', requiredSize=size(prm%Nslip)) + + prm%clambda = config%getFloats('clambdaslip', requiredSize=size(prm%Nslip)) + prm%tau_Peierls = config%getFloats('tau_peierls', requiredSize=size(prm%Nslip)) ! ToDo: Deprecated + prm%p = config%getFloats('p_slip', requiredSize=size(prm%Nslip), & defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%q = config%getFloats('q_slip', requiredShape=shape(prm%Nslip), & + prm%q = config%getFloats('q_slip', requiredSize=size(prm%Nslip), & defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%kink_height = config%getFloats('kink_height', requiredShape=shape(prm%Nslip)) - prm%w = config%getFloats('kink_width', requiredShape=shape(prm%Nslip)) - prm%omega = config%getFloats('omega', requiredShape=shape(prm%Nslip)) - prm%B = config%getFloats('friction_coeff', requiredShape=shape(prm%Nslip)) + prm%kink_height = config%getFloats('kink_height', requiredSize=size(prm%Nslip)) + prm%w = config%getFloats('kink_width', requiredSize=size(prm%Nslip)) + prm%omega = config%getFloats('omega', requiredSize=size(prm%Nslip)) + prm%B = config%getFloats('friction_coeff', requiredSize=size(prm%Nslip)) prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') ! ToDo: Deprecated prm%grainSize = config%getFloat('grainsize') @@ -250,7 +248,7 @@ subroutine plastic_disloUCLA_init() prm%Qsd = config%getFloat('qsd') prm%atomicVolume = config%getFloat('catomicvolume') * prm%burgers**3.0_pReal prm%minDipDistance = config%getFloat('cedgedipmindistance') * prm%burgers - prm%dipoleformation = config%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default, ToDo: change to /key/-key + prm%dipoleformation = config%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default, ToDo: change to /key/-type key ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) @@ -313,8 +311,6 @@ subroutine plastic_disloUCLA_init() outputID = merge(mfp_ID,undefined_ID,prm%totalNslip>0_pInt) case ('threshold_stress','threshold_stress_slip') outputID = merge(thresholdstress_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('edge_dipole_distance') - outputID = merge(dipoleDistance_ID,undefined_ID,prm%totalNslip>0_pInt) end select @@ -336,24 +332,6 @@ subroutine plastic_disloUCLA_init() prm%totalNslip,0_pInt,0_pInt) plasticState(p)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) - allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) - - i = 0_pInt - mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - - slipSystemsLoop: do j = 1_pInt,prm%Nslip(f) - i = i + 1_pInt - do o = 1_pInt, size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - do k = 1_pInt,prm%Nslip(o) ! loop over (active) systems in other family (slip) - prm%forestProjectionEdge(index_myFamily+j,index_otherFamily+k) = & - abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & - lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) - enddo; enddo - enddo slipSystemsLoop - enddo mySlipFamilies - !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt @@ -374,7 +352,7 @@ subroutine plastic_disloUCLA_init() endIndex = endIndex + prm%totalNslip stt%accshear=>plasticState(p)%state(startIndex:endIndex,:) dot%accshear=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal !ToDo: better make optional parameter + plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal !ToDo: better make optional parameter ! global alias plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) @@ -579,16 +557,6 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe postResults(c+1_pInt:c+prm%totalNslip) = dst%mfp(1_pInt:prm%totalNslip, of) case (thresholdstress_ID) postResults(c+1_pInt:c+prm%totalNslip) = dst%threshold_stress(1_pInt:prm%totalNslip,of) - case (dipoleDistance_ID) ! ToDo: Discuss required changes with Franz - do i = 1_pInt, prm%totalNslip - if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i))))) then - postResults(c+i) = (3.0_pReal*prm%mu*prm%burgers(i)) & - / (16.0_pReal*pi*abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i)))) - else - postResults(c+i) = huge(1.0_pReal) - endif - postResults(c+i)=min(postResults(c+i),dst%mfp(i,of)) - enddo end select diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 00534d251..d9312ae18 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -11,19 +11,19 @@ module plastic_dislotwin use prec, only: & pReal, & pInt - + implicit none private integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_dislotwin_sizePostResult !< size of each post result output + plastic_dislotwin_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_dislotwin_output !< name of each post result output - - real(pReal), parameter, private :: & - kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin + plastic_dislotwin_output !< name of each post result output - enum, bind(c) - enumerator :: & + real(pReal), parameter, private :: & + kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin + + enum, bind(c) + enumerator :: & undefined_ID, & edge_density_ID, & dipole_density_ID, & @@ -33,19 +33,15 @@ module plastic_dislotwin resolved_stress_slip_ID, & threshold_stress_slip_ID, & edge_dipole_distance_ID, & - stress_exponent_ID, & twin_fraction_ID, & - shear_rate_twin_ID, & - accumulated_shear_twin_ID, & mfp_twin_ID, & resolved_stress_twin_ID, & threshold_stress_twin_ID, & resolved_stress_shearband_ID, & shear_rate_shearband_ID, & - stress_trans_fraction_ID, & strain_trans_fraction_ID end enum - + type, private :: tParameters real(pReal) :: & mu, & @@ -56,7 +52,6 @@ module plastic_dislotwin GrainSize, & ! @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_dislotwin_init(fileUnit) +subroutine plastic_dislotwin_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -206,9 +197,6 @@ subroutine plastic_dislotwin_init(fileUnit) debug_constitutive,& debug_levelBasic use math, only: & - math_rotate_forward3333, & - math_Mandel3333to66, & - math_mul3x3, & math_expand,& PI use IO, only: & @@ -230,37 +218,24 @@ subroutine plastic_dislotwin_init(fileUnit) use lattice implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt) :: & + Ninstance, & + p, i, & + NipcMyPhase, outputSize, & + sizeState, sizeDotState, & + startIndex, endIndex - integer(pInt) :: Ninstance,& - f,j,i,k,o,p, & - offset_slip, index_myFamily, index_otherFamily, & - startIndex, endIndex, outputSize - integer(pInt) :: sizeState, sizeDotState - integer(pInt) :: NipcMyPhase - - real(pReal), allocatable, dimension(:,:) :: temp1,temp2 - integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - type(tParameters) :: & - prm - type(tDislotwinState) :: & - stt, & - dot - type(tDislotwinMicrostructure) :: & - mse - integer(kind(undefined_ID)) :: & - outputID !< ID of each post result output + outputID character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & - outputs + outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>' write(6,'(/,a)') ' A. Ma and F. Roters, Acta Materialia, 52(12):3603–3612, 2004' @@ -271,14 +246,12 @@ subroutine plastic_dislotwin_init(fileUnit) write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - + Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOTWIN_ID),pInt) - if (Ninstance == 0_pInt) return - + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(plastic_dislotwin_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(plastic_dislotwin_output(maxval(phase_Noutput),Ninstance)) plastic_dislotwin_output = '' @@ -288,47 +261,52 @@ subroutine plastic_dislotwin_init(fileUnit) allocate(dotState(Ninstance)) allocate(microstructure(Ninstance)) - do p = 1_pInt, size(phase_plasticityInstance) + do p = 1_pInt, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_DISLOTWIN_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & - mse => microstructure(phase_plasticityInstance(p))) + dst => microstructure(phase_plasticityInstance(p)), & + config => config_phase(p)) ! This data is read in already in lattice - prm%isFCC = merge(.true., .false., lattice_structure(p) == LATTICE_FCC_ID) prm%mu = lattice_mu(p) prm%nu = lattice_nu(p) prm%C66 = lattice_C66(1:6,1:6,p) - structure = config_phase(p)%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! slip related parameters - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & - config_phase(p)%getFloats('interaction_slipslip'), & - structure(1:3)) + config%getFloats('interaction_slipslip'), & + config%getString('lattice_structure')) + prm%forestProjection = lattice_forestProjection (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%rho0 = config_phase(p)%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) !ToDo: rename to rho_0 - prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0',requiredShape=shape(prm%Nslip)) !ToDo: rename to rho_dip_0 - prm%v0 = config_phase(p)%getFloats('v0', requiredShape=shape(prm%Nslip)) - prm%burgers_slip = config_phase(p)%getFloats('slipburgers',requiredShape=shape(prm%Nslip)) - prm%Qedge = config_phase(p)%getFloats('qedge', requiredShape=shape(prm%Nslip)) !ToDo: rename (ask Karo) - prm%CLambdaSlip = config_phase(p)%getFloats('clambdaslip',requiredShape=shape(prm%Nslip)) - prm%p = config_phase(p)%getFloats('p_slip', requiredShape=shape(prm%Nslip)) - prm%q = config_phase(p)%getFloats('q_slip', requiredShape=shape(prm%Nslip)) - prm%B = config_phase(p)%getFloats('b', requiredShape=shape(prm%Nslip), & - defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) - prm%tau_peierls = config_phase(p)%getFloats('tau_peierls',requiredShape=shape(prm%Nslip), & - defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) + prm%fccTwinTransNucleation = merge(.true., .false., lattice_structure(p) == LATTICE_FCC_ID) & + .and. (prm%Nslip(1) == 12_pInt) + if(prm%fccTwinTransNucleation) & + prm%fcc_twinNucleationSlipPair = lattice_fcc_twinNucleationSlipPair - prm%CEdgeDipMinDistance = config_phase(p)%getFloat('cedgedipmindistance') + prm%rho0 = config%getFloats('rhoedge0', requiredSize=size(prm%Nslip)) !ToDo: rename to rho_0 + prm%rhoDip0 = config%getFloats('rhoedgedip0',requiredSize=size(prm%Nslip)) !ToDo: rename to rho_dip_0 + prm%v0 = config%getFloats('v0', requiredSize=size(prm%Nslip)) + prm%burgers_slip = config%getFloats('slipburgers',requiredSize=size(prm%Nslip)) + prm%Qedge = config%getFloats('qedge', requiredSize=size(prm%Nslip)) !ToDo: rename (ask Karo) + prm%CLambdaSlip = config%getFloats('clambdaslip',requiredSize=size(prm%Nslip)) + prm%p = config%getFloats('p_slip', requiredSize=size(prm%Nslip)) + prm%q = config%getFloats('q_slip', requiredSize=size(prm%Nslip)) + prm%B = config%getFloats('b', requiredSize=size(prm%Nslip), & + defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) + prm%tau_peierls = config%getFloats('tau_peierls',requiredSize=size(prm%Nslip), & + defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) ! Deprecated + + prm%CEdgeDipMinDistance = config%getFloat('cedgedipmindistance') ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) @@ -340,7 +318,7 @@ subroutine plastic_dislotwin_init(fileUnit) prm%p = math_expand(prm%p, prm%Nslip) prm%q = math_expand(prm%q, prm%Nslip) prm%B = math_expand(prm%B, prm%Nslip) - prm%tau_peierls = math_expand(prm%tau_peierls, prm%Nslip) + prm%tau_peierls = math_expand(prm%tau_peierls, prm%Nslip) ! sanity checks if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//'rho0 ' @@ -360,28 +338,32 @@ subroutine plastic_dislotwin_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! twin related parameters - prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) + prm%Ntwin = config%getInts('ntwin', defaultVal=emptyIntArray) prm%totalNtwin = sum(prm%Ntwin) if (prm%totalNtwin > 0_pInt) then - prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,& - config_phase(p)%getFloats('interaction_twintwin'), & - structure(1:3)) + config%getFloats('interaction_twintwin'), & + config%getString('lattice_structure')) - prm%burgers_twin = config_phase(p)%getFloats('twinburgers') - prm%twinsize = config_phase(p)%getFloats('twinsize') - prm%r = config_phase(p)%getFloats('r_twin') + prm%burgers_twin = config%getFloats('twinburgers', requiredSize=size(prm%Ntwin)) + prm%twinsize = config%getFloats('twinsize', requiredSize=size(prm%Ntwin)) + prm%r = config%getFloats('r_twin', requiredSize=size(prm%Ntwin)) - prm%xc_twin = config_phase(p)%getFloat('xc_twin') - prm%L0_twin = config_phase(p)%getFloat('l0_twin') - prm%MaxTwinFraction = config_phase(p)%getFloat('maxtwinfraction') ! ToDo: only used in postResults - prm%Cthresholdtwin = config_phase(p)%getFloat('cthresholdtwin', defaultVal=0.0_pReal) - prm%Cmfptwin = config_phase(p)%getFloat('cmfptwin', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%xc_twin = config%getFloat('xc_twin') + prm%L0_twin = config%getFloat('l0_twin') + prm%Cthresholdtwin = config%getFloat('cthresholdtwin', defaultVal=0.0_pReal) + prm%Cmfptwin = config%getFloat('cmfptwin', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%shear_twin = lattice_characteristicShear_Twin(prm%Ntwin,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - if (.not. prm%isFCC) then - prm%Ndot0_twin = config_phase(p)%getFloats('ndot0_twin') + prm%C66_twin = lattice_C66_twin(prm%Ntwin,prm%C66,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + if (.not. prm%fccTwinTransNucleation) then + prm%Ndot0_twin = config%getFloats('ndot0_twin') prm%Ndot0_twin = math_expand(prm%Ndot0_twin,prm%Ntwin) endif @@ -398,73 +380,91 @@ subroutine plastic_dislotwin_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! transformation related parameters - prm%Ntrans = config_phase(p)%getInts('ntrans', defaultVal=emptyIntArray) + prm%Ntrans = config%getInts('ntrans', defaultVal=emptyIntArray) prm%totalNtrans = sum(prm%Ntrans) if (prm%totalNtrans > 0_pInt) then - prm%burgers_trans = config_phase(p)%getFloats('transburgers') + prm%burgers_trans = config%getFloats('transburgers') prm%burgers_trans = math_expand(prm%burgers_trans,prm%Ntrans) - prm%Cthresholdtrans = config_phase(p)%getFloat('cthresholdtrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%transStackHeight = config_phase(p)%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%Cmfptrans = config_phase(p)%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%deltaG = config_phase(p)%getFloat('deltag') - prm%xc_trans = config_phase(p)%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%L0_trans = config_phase(p)%getFloat('l0_trans') + prm%Cthresholdtrans = config%getFloat('cthresholdtrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%transStackHeight = config%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%Cmfptrans = config%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%deltaG = config%getFloat('deltag') + prm%xc_trans = config%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%L0_trans = config%getFloat('l0_trans') - prm%interaction_TransTrans = spread(config_phase(p)%getFloats('interaction_transtrans'),2,1) + prm%interaction_TransTrans = lattice_interaction_TransTrans(prm%Ntrans,& + config%getFloats('interaction_transtrans'), & + config%getString('lattice_structure')) + + prm%C66_trans = lattice_C66_trans(prm%Ntrans,prm%C66, & + config%getString('trans_lattice_structure'), & + 0.0_pReal, & + config%getFloat('a_bcc', defaultVal=0.0_pReal), & + config%getFloat('a_fcc', defaultVal=0.0_pReal)) + + prm%Schmid_trans = lattice_SchmidMatrix_trans(prm%Ntrans, & + config%getString('trans_lattice_structure'), & + 0.0_pReal, & + config%getFloat('a_bcc', defaultVal=0.0_pReal), & + config%getFloat('a_fcc', defaultVal=0.0_pReal)) + if (lattice_structure(p) /= LATTICE_fcc_ID) then - prm%Ndot0_trans = config_phase(p)%getFloats('ndot0_trans') + prm%Ndot0_trans = config%getFloats('ndot0_trans') prm%Ndot0_trans = math_expand(prm%Ndot0_trans,prm%Ntrans) endif - prm%lamellarsizePerTransSystem = config_phase(p)%getFloats('lamellarsize') - prm%lamellarsizePerTransSystem = math_expand(prm%lamellarsizePerTransSystem,prm%Ntrans) - prm%s = config_phase(p)%getFloats('s_trans',defaultVal=[0.0_pReal]) + prm%lamellarsize = config%getFloats('lamellarsize') + prm%lamellarsize = math_expand(prm%lamellarsize,prm%Ntrans) + prm%s = config%getFloats('s_trans',defaultVal=[0.0_pReal]) prm%s = math_expand(prm%s,prm%Ntrans) else - allocate(prm%lamellarsizePerTransSystem(0)) + allocate(prm%lamellarsize(0)) allocate(prm%burgers_trans(0)) endif if (sum(prm%Ntwin) > 0_pInt .or. prm%totalNtrans > 0_pInt) then - prm%SFE_0K = config_phase(p)%getFloat('sfe_0k') - prm%dSFE_dT = config_phase(p)%getFloat('dsfe_dt') - prm%VcrossSlip = config_phase(p)%getFloat('vcrossslip') + prm%SFE_0K = config%getFloat('sfe_0k') + prm%dSFE_dT = config%getFloat('dsfe_dt') + prm%VcrossSlip = config%getFloat('vcrossslip') endif if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,& - config_phase(p)%getFloats('interaction_sliptwin'), & - structure(1:3)) + config%getFloats('interaction_sliptwin'), & + config%getString('lattice_structure')) prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,& - config_phase(p)%getFloats('interaction_twinslip'), & - structure(1:3)) + config%getFloats('interaction_twinslip'), & + config%getString('lattice_structure')) + if (prm%fccTwinTransNucleation .and. prm%totalNtwin > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntwin is [6,6] endif - if (prm%totalNslip > 0_pInt .and. prm%totalNtrans > 0_pInt) then - prm%interaction_TransSlip = spread(config_phase(p)%getFloats('interaction_transslip'),2,1) - prm%interaction_SlipTrans = spread(config_phase(p)%getFloats('interaction_sliptrans'),2,1) + if (prm%totalNslip > 0_pInt .and. prm%totalNtrans > 0_pInt) then + prm%interaction_SlipTrans = lattice_interaction_SlipTrans(prm%Nslip,prm%Ntrans,& + config%getFloats('interaction_sliptrans'), & + config%getString('lattice_structure')) + if (prm%fccTwinTransNucleation .and. prm%totalNtrans > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntrans is [6,6] endif - prm%aTolRho = config_phase(p)%getFloat('atol_rho', defaultVal=0.0_pReal) - prm%aTolTwinFrac = config_phase(p)%getFloat('atol_twinfrac', defaultVal=0.0_pReal) - prm%aTolTransFrac = config_phase(p)%getFloat('atol_transfrac', defaultVal=0.0_pReal) + prm%aTolRho = config%getFloat('atol_rho', defaultVal=0.0_pReal) + prm%aTolTwinFrac = config%getFloat('atol_twinfrac', defaultVal=0.0_pReal) + prm%aTolTransFrac = config%getFloat('atol_transfrac', defaultVal=0.0_pReal) - prm%CAtomicVolume = config_phase(p)%getFloat('catomicvolume') - prm%GrainSize = config_phase(p)%getFloat('grainsize') + prm%CAtomicVolume = config%getFloat('catomicvolume') + prm%GrainSize = config%getFloat('grainsize') - prm%D0 = config_phase(p)%getFloat('d0') - prm%Qsd = config_phase(p)%getFloat('qsd') - prm%SolidSolutionStrength = config_phase(p)%getFloat('solidsolutionstrength') - if (config_phase(p)%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') - prm%dipoleformation = .not. config_phase(p)%keyExists('/nodipoleformation/') - prm%sbVelocity = config_phase(p)%getFloat('shearbandvelocity',defaultVal=0.0_pReal) + prm%D0 = config%getFloat('d0') + prm%Qsd = config%getFloat('qsd') + prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') ! Deprecated + if (config%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') + prm%dipoleformation = .not. config%keyExists('/nodipoleformation/') + prm%sbVelocity = config%getFloat('shearbandvelocity',defaultVal=0.0_pReal) if (prm%sbVelocity > 0.0_pReal) then - prm%sbResistance = config_phase(p)%getFloat('shearbandresistance') - prm%sbQedge = config_phase(p)%getFloat('qedgepersbsystem') - prm%pShearBand = config_phase(p)%getFloat('p_shearband') - prm%qShearBand = config_phase(p)%getFloat('q_shearband') + prm%sbResistance = config%getFloat('shearbandresistance') + prm%sbQedge = config%getFloat('qedgepersbsystem') + prm%pShearBand = config%getFloat('p_shearband') + prm%qShearBand = config%getFloat('q_shearband') endif !if (Ndot0PerTwinFamily(f,p) < 0.0_pReal) & @@ -505,7 +505,7 @@ subroutine plastic_dislotwin_init(fileUnit) prm%qShearBand <= 0.0_pReal) & call IO_error(211_pInt,el=p,ext_msg='qShearBand ('//PLASTICITY_DISLOTWIN_label//')') - outputs = config_phase(p)%getStrings('(output)', defaultVal=emptyStringArray) + outputs = config%getStrings('(output)', defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i= 1_pInt, size(outputs) outputID = undefined_ID @@ -531,22 +531,10 @@ subroutine plastic_dislotwin_init(fileUnit) case ('threshold_stress_slip') outputID= merge(threshold_stress_slip_ID,undefined_ID,prm%totalNslip > 0_pInt) outputSize = prm%totalNslip - case ('edge_dipole_distance') - outputID = merge(edge_dipole_distance_ID,undefined_ID,prm%totalNslip > 0_pInt) - outputSize = prm%totalNslip - case ('stress_exponent') - outputID = merge(stress_exponent_ID,undefined_ID,prm%totalNslip > 0_pInt) - outputSize = prm%totalNslip case ('twin_fraction') outputID = merge(twin_fraction_ID,undefined_ID,prm%totalNtwin >0_pInt) outputSize = prm%totalNtwin - case ('shear_rate_twin','shearrate_twin') - outputID = merge(shear_rate_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) - outputSize = prm%totalNtwin - case ('accumulated_shear_twin') - outputID = merge(accumulated_shear_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) - outputSize = prm%totalNtwin case ('mfp_twin') outputID = merge(mfp_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) outputSize = prm%totalNtwin @@ -557,16 +545,6 @@ subroutine plastic_dislotwin_init(fileUnit) outputID = merge(threshold_stress_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) outputSize = prm%totalNtwin - case ('resolved_stress_shearband') - outputID = resolved_stress_shearband_ID - outputSize = 6_pInt - case ('shear_rate_shearband','shearrate_shearband') - outputID = shear_rate_shearband_ID - outputSize = 6_pInt - - case ('stress_trans_fraction') - outputID = stress_trans_fraction_ID - outputSize = prm%totalNtrans case ('strain_trans_fraction') outputID = strain_trans_fraction_ID outputSize = prm%totalNtrans @@ -578,195 +556,91 @@ subroutine plastic_dislotwin_init(fileUnit) plastic_dislotwin_sizePostResult(i,phase_plasticityInstance(p)) = outputSize prm%outputID = [prm%outputID, outputID] endif + enddo - !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase=count(material_phase==p) - sizeDotState = int(size(['rho ','rhoDip ','accshearslip']),pInt) * prm%totalNslip & - + int(size(['twinFraction','accsheartwin']),pInt) * prm%totalNtwin & - + int(size(['stressTransFraction','strainTransFraction']),pInt) * prm%totalNtrans - sizeState = sizeDotState + NipcMyPhase = count(material_phase == p) + sizeDotState = int(size(['rho ','rhoDip ','accshearslip']),pInt) * prm%totalNslip & + + int(size(['twinFraction']),pInt) * prm%totalNtwin & + + int(size(['strainTransFraction']),pInt) * prm%totalNtrans + sizeState = sizeDotState call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & prm%totalNslip,prm%totalNtwin,prm%totalNtrans) plasticState(p)%sizePostResults = sum(plastic_dislotwin_sizePostResult(:,phase_plasticityInstance(p))) - ! ToDo: do later on - offset_slip = 2_pInt*plasticState(p)%nslip - plasticState(p)%slipRate => & - plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nslip,1:NipcMyPhase) - plasticState(p)%accumulatedSlip => & - plasticState(p)%state (offset_slip+1:offset_slip+plasticState(p)%nslip,1:NipcMyPhase) - - allocate(temp1(prm%totalNslip,prm%totalNtrans),source =0.0_pReal) - allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) - i = 0_pInt - mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - slipSystemsLoop: do j = 1_pInt,prm%Nslip(f) - i = i + 1_pInt - do o = 1_pInt, size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - do k = 1_pInt,prm%Nslip(o) ! loop over (active) systems in other family (slip) - prm%forestProjectionEdge(index_myFamily+j,index_otherFamily+k) = & - abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & - lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) - enddo; enddo - do o = 1_pInt,size(prm%Ntrans,1) - index_otherFamily = sum(prm%Ntrans(1:o-1_pInt)) - do k = 1_pInt,prm%Ntrans(o) ! loop over (active) systems in other family (trans) - temp1(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_SlipTrans(lattice_interactionSlipTrans( & - sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtransSystem(1:o-1_pInt,p))+k, & - p),1 ) - enddo; enddo - - enddo slipSystemsLoop - enddo mySlipFamilies - prm%interaction_SlipTrans = temp1; deallocate(temp1) - - allocate(prm%C66_twin(6,6,prm%totalNtwin), source=0.0_pReal) - if (lattice_structure(p) == LATTICE_fcc_ID) & - allocate(prm%fcc_twinNucleationSlipPair(2,prm%totalNtwin),source = 0_pInt) - allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal) - i = 0_pInt - twinFamiliesLoop: do f = 1_pInt, size(prm%Ntwin,1) - index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) ! index in truncated twin system list - twinSystemsLoop: do j = 1_pInt,prm%Ntwin(f) - i = i + 1_pInt - prm%shear_twin(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p) - if (lattice_structure(p) == LATTICE_fcc_ID) prm%fcc_twinNucleationSlipPair(1:2,i) = & - lattice_fcc_twinNucleationSlipPair(1:2,sum(lattice_Ntwinsystem(1:f-1,p))+j) - !* Rotate twin elasticity matrices - index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,p)) ! index in full lattice twin list - prm%C66_twin(1:6,1:6,index_myFamily+j) = & - math_Mandel3333to66(math_rotate_forward3333(lattice_C3333(1:3,1:3,1:3,1:3,p),& - lattice_Qtwin(1:3,1:3,index_otherFamily+j,p))) - enddo twinSystemsLoop - enddo twinFamiliesLoop - - - allocate(temp1(prm%totalNtrans,prm%totalNslip), source =0.0_pReal) - allocate(temp2(prm%totalNtrans,prm%totalNtrans), source =0.0_pReal) - allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) - allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) - i = 0_pInt - transFamiliesLoop: do f = 1_pInt,size(prm%Ntrans,1) - index_myFamily = sum(prm%Ntrans(1:f-1_pInt)) ! index in truncated trans system list - transSystemsLoop: do j = 1_pInt,prm%Ntrans(f) - i = i + 1_pInt - prm%Schmid_trans(1:3,1:3,i) = lattice_Strans(1:3,1:3,sum(lattice_Ntranssystem(1:f-1,p))+j,p) - !* Rotate trans elasticity matrices - index_otherFamily = sum(lattice_NtransSystem(1:f-1_pInt,p)) ! index in full lattice trans list - prm%C66_trans(1:6,1:6,index_myFamily+j) = & - math_Mandel3333to66(math_rotate_forward3333(lattice_trans_C3333(1:3,1:3,1:3,1:3,p),& - lattice_Qtrans(1:3,1:3,index_otherFamily+j,p))) - !* Interaction matrices - do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - do k = 1_pInt,prm%Nslip(o) ! loop over (active) systems in other family (slip) - temp1(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TransSlip(lattice_interactionTransSlip( & - sum(lattice_NtransSystem(1:f-1_pInt,p))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & - p) ,1 ) - enddo; enddo - - do o = 1_pInt,size(prm%Ntrans,1) - index_otherFamily = sum(prm%Ntrans(1:o-1_pInt)) - do k = 1_pInt,prm%Ntrans(o) ! loop over (active) systems in other family (trans) - temp2(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TransTrans(lattice_interactionTransTrans( & - sum(lattice_NtransSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtransSystem(1:o-1_pInt,p))+k, & - p),1 ) - enddo; enddo - - enddo transSystemsLoop - enddo transFamiliesLoop - prm%interaction_TransSlip = temp1; deallocate(temp1) - prm%interaction_TransTrans = temp2; deallocate(temp2) - - startIndex=1_pInt - endIndex=prm%totalNslip +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases and initialization of state0 and aTolState + startIndex = 1_pInt + endIndex = prm%totalNslip stt%rhoEdge=>plasticState(p)%state(startIndex:endIndex,:) stt%rhoEdge= spread(prm%rho0,2,NipcMyPhase) dot%rhoEdge=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - startIndex=endIndex+1 - endIndex=endIndex+prm%totalNslip + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip stt%rhoEdgeDip=>plasticState(p)%state(startIndex:endIndex,:) stt%rhoEdgeDip= spread(prm%rhoDip0,2,NipcMyPhase) dot%rhoEdgeDip=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - - startIndex=endIndex+1 - endIndex=endIndex+prm%totalNslip + + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip stt%accshear_slip=>plasticState(p)%state(startIndex:endIndex,:) dot%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal + plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal !ToDo: better make optional parameter + ! global alias + plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) - startIndex=endIndex+1 + startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtwin stt%twinFraction=>plasticState(p)%state(startIndex:endIndex,:) dot%twinFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac - startIndex=endIndex+1 - endIndex=endIndex+prm%totalNtwin - stt%accshear_twin=>plasticState(p)%state(startIndex:endIndex,:) - dot%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal - - startIndex=endIndex+1 - endIndex=endIndex+prm%totalNtrans - stt%stressTransFraction=>plasticState(p)%state(startIndex:endIndex,:) - dot%stressTransFraction=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTransFrac - - startIndex=endIndex+1 + startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtrans stt%strainTransFraction=>plasticState(p)%state(startIndex:endIndex,:) dot%strainTransFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTransFrac - plasticState(p)%state0 = plasticState(p)%state - dot%whole => plasticState(p)%dotState + allocate(dst%invLambdaSlip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%invLambdaSlipTwin (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%invLambdaSlipTrans (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%mfp_slip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress_slip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaSlip(prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaSlipTwin(prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaTwin(prm%totalNtwin,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaSlipTrans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaTrans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%invLambdaTwin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%mfp_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_r_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) !* equilibrium separation of partial dislocations (twin) + allocate(dst%twinVolume (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) - allocate(mse%mfp_slip(prm%totalNslip,NipcMyPhase), source=0.0_pReal) - allocate(mse%mfp_twin(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) - allocate(mse%mfp_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%invLambdaTrans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%mfp_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) !* equilibrium separation of partial dislocations (trans) + allocate(dst%martensiteVolume (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - allocate(mse%threshold_stress_slip(prm%totalNslip,NipcMyPhase), source=0.0_pReal) - allocate(mse%threshold_stress_twin(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) - allocate(mse%threshold_stress_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - allocate(mse%tau_r_twin(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) - allocate(mse%tau_r_trans(prm%totalNtrans,NipcMyPhase), source=0.0_pReal) - - allocate(mse%twinVolume(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) - allocate(mse%martensiteVolume(prm%totalNtrans,NipcMyPhase), source=0.0_pReal) + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate + enddo - + end subroutine plastic_dislotwin_init + !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- -function plastic_dislotwin_homogenizedC(ipc,ip,el) +function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) use material, only: & material_phase, & phase_plasticityInstance, & @@ -774,13 +648,11 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) implicit none real(pReal), dimension(6,6) :: & - plastic_dislotwin_homogenizedC + homogenizedC integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element - type(tParameters) :: prm - type(tDislotwinState) :: stt integer(pInt) :: i, & of @@ -792,152 +664,21 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) - plastic_dislotwin_homogenizedC = f_unrotated * prm%C66 + homogenizedC = f_unrotated * prm%C66 do i=1_pInt,prm%totalNtwin - plastic_dislotwin_homogenizedC = plastic_dislotwin_homogenizedC & - + stt%twinFraction(i,of)*prm%C66_twin(1:6,1:6,i) + homogenizedC = homogenizedC & + + stt%twinFraction(i,of)*prm%C66_twin(1:6,1:6,i) enddo do i=1_pInt,prm%totalNtrans - plastic_dislotwin_homogenizedC = plastic_dislotwin_homogenizedC & - +(stt%stressTransFraction(i,of)+stt%strainTransFraction(i,of))*& - prm%C66_trans(1:6,1:6,i) + homogenizedC = homogenizedC & + + stt%strainTransFraction(i,of)*prm%C66_trans(1:6,1:6,i) enddo + end associate - end function plastic_dislotwin_homogenizedC - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -subroutine plastic_dislotwin_microstructure(temperature,ipc,ip,el) - use math, only: & - PI - use material, only: & - material_phase, & - phase_plasticityInstance, & - phasememberAt - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in) :: & - temperature !< temperature at IP - - integer(pInt) :: & - i, & - of - real(pReal) :: & - sumf_twin,SFE,sumf_trans - real(pReal), dimension(:), allocatable :: & - x0, & - fOverStacksize, & - ftransOverLamellarSize - - type(tParameters) :: prm !< parameters of present instance - type(tDislotwinState) :: stt !< state of present instance - type(tDislotwinMicrostructure) :: mse - - of = phasememberAt(ipc,ip,el) - - associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& - stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))),& - mse => microstructure(phase_plasticityInstance(material_phase(ipc,ip,el)))) - - sumf_twin = sum(stt%twinFraction(1:prm%totalNtwin,of)) - sumf_trans = sum(stt%stressTransFraction(1:prm%totalNtrans,of)) & - + sum(stt%strainTransFraction(1:prm%totalNtrans,of)) - - sfe = prm%SFE_0K + prm%dSFE_dT * Temperature - !* rescaled volume fraction for topology - fOverStacksize = stt%twinFraction(1_pInt:prm%totalNtwin,of)/prm%twinsize !ToDo: this is per system - ftransOverLamellarSize = sumf_trans/prm%lamellarsizePerTransSystem !ToDo: But this not ... - !Todo: Physically ok, but naming could be adjusted - - - !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation - forall (i = 1_pInt:prm%totalNslip) & - mse%invLambdaSlip(i,of) = & - sqrt(dot_product((stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of)),& - prm%forestProjectionEdge(1:prm%totalNslip,i)))/prm%CLambdaSlip(i) - - !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation - !$OMP CRITICAL (evilmatmul) - if (prm%totalNtwin > 0_pInt .and. prm%totalNslip > 0_pInt) & - mse%invLambdaSlipTwin(1_pInt:prm%totalNslip,of) = & - matmul(prm%interaction_SlipTwin,fOverStacksize)/(1.0_pReal-sumf_twin) - - !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin - - !ToDo: needed? if (prm%totalNtwin > 0_pInt) & - mse%invLambdaTwin(1_pInt:prm%totalNtwin,of) = & - matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) - - - !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation - if (prm%totalNtrans > 0_pInt .and. prm%totalNslip > 0_pInt) & - mse%invLambdaSlipTrans(1_pInt:prm%totalNslip,of) = & - matmul(prm%interaction_SlipTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) - - !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) - !ToDo: needed? if (prm%totalNtrans > 0_pInt) & - - mse%invLambdaTrans(1_pInt:prm%totalNtrans,of) = & - matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) - !$OMP END CRITICAL (evilmatmul) - - !* mean free path between 2 obstacles seen by a moving dislocation - do i = 1_pInt,prm%totalNslip - if ((prm%totalNtwin > 0_pInt) .or. (prm%totalNtrans > 0_pInt)) then ! ToDo: This is too simplified - mse%mfp_slip(i,of) = & - prm%GrainSize/(1.0_pReal+prm%GrainSize*& - (mse%invLambdaSlip(i,of) + mse%invLambdaSlipTwin(i,of) + mse%invLambdaSlipTrans(i,of))) - else - mse%mfp_slip(i,of) = & - prm%GrainSize/& - (1.0_pReal+prm%GrainSize*(mse%invLambdaSlip(i,of))) !!!!!! correct? - endif - enddo - - !* mean free path between 2 obstacles seen by a growing twin/martensite - mse%mfp_twin(:,of) = prm%Cmfptwin*prm%GrainSize/ (1.0_pReal+prm%GrainSize*mse%invLambdaTwin(:,of)) - mse%mfp_trans(:,of) = prm%Cmfptrans*prm%GrainSize/(1.0_pReal+prm%GrainSize*mse%invLambdaTrans(:,of)) - - !* threshold stress for dislocation motion - forall (i = 1_pInt:prm%totalNslip) mse%threshold_stress_slip(i,of) = & - prm%mu*prm%burgers_slip(i)*& - sqrt(dot_product(stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of),& - prm%interaction_SlipSlip(i,1:prm%totalNslip))) - - !* threshold stress for growing twin/martensite - if(prm%totalNtwin == prm%totalNslip) & - mse%threshold_stress_twin(:,of) = prm%Cthresholdtwin* & - (sfe/(3.0_pReal*prm%burgers_twin)+ 3.0_pReal*prm%burgers_twin*prm%mu/ & - (prm%L0_twin*prm%burgers_slip)) ! slip burgers here correct? - if(prm%totalNtrans == prm%totalNslip) & - mse%threshold_stress_trans(:,of) = prm%Cthresholdtrans* & - (sfe/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& - (prm%L0_trans*prm%burgers_slip) + prm%transStackHeight*prm%deltaG/ (3.0_pReal*prm%burgers_trans) ) - - ! final volume after growth - mse%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*mse%mfp_twin(:,of)**2.0_pReal - mse%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsizePerTransSystem*mse%mfp_trans(:,of)**2.0_pReal - - !* equilibrium separation of partial dislocations (twin) - x0 = prm%mu*prm%burgers_twin**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) - mse%tau_r_twin(:,of) = prm%mu*prm%burgers_twin/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) - - !* equilibrium separation of partial dislocations (trans) - x0 = prm%mu*prm%burgers_trans**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) - mse%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) - -end associate -end subroutine plastic_dislotwin_microstructure +end function plastic_dislotwin_homogenizedC !-------------------------------------------------------------------------------------------------- @@ -953,10 +694,6 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, math_symmetric33, & math_mul33xx33, & math_mul33x3 - use material, only: & - material_phase, & - phase_plasticityInstance, & - phasememberAt implicit none real(pReal), dimension(3,3), intent(out) :: Lp @@ -965,19 +702,20 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, integer(pInt), intent(in) :: instance,of real(pReal), intent(in) :: Temperature - integer(pInt) :: i,k,l,m,n,s1,s2 + integer(pInt) :: i,k,l,m,n real(pReal) :: f_unrotated,StressRatio_p,& - StressRatio_r,BoltzmannRatio,Ndot0_twin,stressRatio, & - Ndot0_trans,StressRatio_s, & + BoltzmannRatio, & dgdot_dtau, & tau real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip,dgdot_dtau_slip real(pReal), dimension(param(instance)%totalNtwin) :: & gdot_twin,dgdot_dtau_twin - real(pReal):: gdot_sb,gdot_trans + real(pReal), dimension(param(instance)%totalNtrans) :: & + gdot_trans,dgdot_dtau_trans + real(pReal):: gdot_sb real(pReal), dimension(3,3) :: eigVectors, Schmid_shearBand - real(pReal), dimension(3) :: eigValues, sb_s, sb_m + real(pReal), dimension(3) :: eigValues logical :: error real(pReal), dimension(3,6), parameter :: & sb_sComposition = & @@ -998,21 +736,17 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, 0, 1,-1, & 0, 1, 1 & ],pReal),[ 3,6]) - - type(tParameters) :: prm !< parameters of present instance - type(tDislotwinState) :: ste !< state of present instance - associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal - call kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau_slip) + call kinetics_slip(Mp,temperature,instance,of,gdot_slip,dgdot_dtau_slip) slipContribution: do i = 1_pInt, prm%totalNslip Lp = Lp + gdot_slip(i)*prm%Schmid_slip(1:3,1:3,i) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & @@ -1030,15 +764,14 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, call math_eigenValuesVectorsSym(Mp,eigValues,eigVectors,error) do i = 1_pInt,6_pInt - sb_s = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_sComposition(1:3,i)) - sb_m = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_mComposition(1:3,i)) - Schmid_shearBand = math_tensorproduct33(sb_s,sb_m) + Schmid_shearBand = 0.5_pReal * math_tensorproduct33(math_mul33x3(eigVectors,sb_sComposition(1:3,i)),& + math_mul33x3(eigVectors,sb_mComposition(1:3,i))) tau = math_mul33xx33(Mp,Schmid_shearBand) significantShearBandStress: if (abs(tau) > tol_math_check) then - StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand + StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand gdot_sb = sign(prm%sbVelocity*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**prm%qShearBand), tau) - dgdot_dtau = ((abs(gdot_sb)*BoltzmannRatio* prm%pShearBand*prm%qShearBand)/ prm%sbResistance) & + dgdot_dtau = abs(gdot_sb)*BoltzmannRatio* prm%pShearBand*prm%qShearBand/ prm%sbResistance & * (abs(tau)/prm%sbResistance)**(prm%pShearBand-1.0_pReal) & * (1.0_pReal-StressRatio_p)**(prm%qShearBand-1.0_pReal) @@ -1051,49 +784,22 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, endif shearBandingContribution - call kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin,dgdot_dtau_twin) - gdot_twin = f_unrotated * gdot_twin - dgdot_dtau_twin = f_unrotated * dgdot_dtau_twin + call kinetics_twin(Mp,temperature,gdot_slip,instance,of,gdot_twin,dgdot_dtau_twin) twinContibution: do i = 1_pInt, prm%totalNtwin - Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i) + Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i) * f_unrotated forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + dgdot_dtau_twin(i)* prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) + + dgdot_dtau_twin(i)* prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) * f_unrotated enddo twinContibution + + call kinetics_twin(Mp,temperature,gdot_slip,instance,of,gdot_trans,dgdot_dtau_trans) + transContibution: do i = 1_pInt, prm%totalNtrans + Lp = Lp + gdot_trans(i)*prm%Schmid_trans(1:3,1:3,i) * f_unrotated + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + dgdot_dtau_trans(i)* prm%Schmid_trans(k,l,i)*prm%Schmid_trans(m,n,i) * f_unrotated + enddo transContibution - transConstribution: do i = 1_pInt, prm%totalNtrans - - tau = math_mul33xx33(Mp,prm%Schmid_trans(1:3,1:3,i)) - - significantTransStress: if (tau > tol_math_check) then - StressRatio_s = (mse%threshold_stress_trans(i,of)/tau)**prm%s(i) - - isFCCtrans: if (prm%isFCC) then - s1=prm%fcc_twinNucleationSlipPair(1,i) - s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau < mse%tau_r_trans(i,of)) then - Ndot0_trans=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& !!!!! correct? - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_trans*prm%burgers_slip(i))*& - (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*(mse%tau_r_trans(i,of)-tau))) - else - Ndot0_trans=0.0_pReal - end if - else isFCCtrans - Ndot0_trans=prm%Ndot0_trans(i) - endif isFCCtrans - - gdot_trans = mse%martensiteVolume(i,of) * Ndot0_trans*exp(-StressRatio_s) - gdot_trans = f_unrotated * gdot_trans - dgdot_dtau = ((gdot_trans*prm%s(i))/tau)*StressRatio_s - Lp = Lp + gdot_trans*prm%Schmid_trans(1:3,1:3,i) - - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + dgdot_dtau * prm%Schmid_trans(k,l,i)* prm%Schmid_trans(m,n,i) - endif significantTransStress - - enddo transConstribution end associate @@ -1109,13 +815,9 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) dEq0 use math, only: & math_mul33xx33, & - math_Mandel6to33, & pi use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phasememberAt + plasticState implicit none real(pReal), dimension(3,3), intent(in):: & @@ -1126,43 +828,39 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) instance, & of - integer(pInt) :: i,s1,s2 - real(pReal) :: f_unrotated,StressRatio_p,BoltzmannRatio,& - EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,StressRatio_r,Ndot0_twin,stressRatio,& - Ndot0_trans,StressRatio_s,EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & + integer(pInt) :: i + real(pReal) :: f_unrotated,& + EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,& + EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & DotRhoDipFormation,DotRhoMultiplication,DotRhoEdgeEdgeAnnihilation, & tau real(pReal), dimension(plasticState(instance)%Nslip) :: & - gdot_slip - - - type(tParameters) :: prm - type(tDislotwinState) :: stt, dot - type(tDislotwinMicrostructure) :: mse - + gdot_slip + real(pReal), dimension(plasticState(instance)%Ntwin) :: & + gdot_twin + real(pReal), dimension(plasticState(instance)%Ntrans) :: & + gdot_trans associate(prm => param(instance), stt => state(instance), & - dot => dotstate(instance), mse => microstructure(instance)) - - dot%whole(:,of) = 0.0_pReal + dot => dotstate(instance), dst => microstructure(instance)) f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) - call kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip) + call kinetics_slip(Mp,temperature,instance,of,gdot_slip) + slipState: do i = 1_pInt, prm%totalNslip tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) - DotRhoMultiplication = abs(gdot_slip(i))/(prm%burgers_slip(i)*mse%mfp_slip(i,of)) + DotRhoMultiplication = abs(gdot_slip(i))/(prm%burgers_slip(i)*dst%mfp_slip(i,of)) EdgeDipMinDistance = prm%CEdgeDipMinDistance*prm%burgers_slip(i) significantSlipStress2: if (dEq0(tau)) then DotRhoDipFormation = 0.0_pReal else significantSlipStress2 EdgeDipDistance = (3.0_pReal*prm%mu*prm%burgers_slip(i))/(16.0_pReal*PI*abs(tau)) - if (EdgeDipDistance>mse%mfp_slip(i,of)) EdgeDipDistance = mse%mfp_slip(i,of) + if (EdgeDipDistance>dst%mfp_slip(i,of)) EdgeDipDistance = dst%mfp_slip(i,of) if (EdgeDipDistance tol_math_check) then - StressRatio_r = (mse%threshold_stress_twin(i,of)/tau)**prm%r(i) - isFCCtwin: if (prm%isFCC) then - s1=prm%fcc_twinNucleationSlipPair(1,i) - s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau < mse%tau_r_twin(i,of)) then - Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_twin*prm%burgers_slip(i))*(1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_twin(i,of)-tau))) - else - Ndot0_twin=0.0_pReal - end if - else isFCCtwin - Ndot0_twin=prm%Ndot0_twin(i) - endif isFCCtwin - dot%twinFraction(i,of) = f_unrotated * mse%twinVolume(i,of)*Ndot0_twin*exp(-StressRatio_r) - dot%accshear_twin(i,of) = dot%twinFraction(i,of) * prm%shear_twin(i) - endif significantTwinStress - - enddo twinState + call kinetics_twin(Mp,temperature,gdot_slip,instance,of,gdot_twin) + dot%twinFraction(:,of) = f_unrotated*gdot_twin/prm%shear_twin - transState: do i = 1_pInt, prm%totalNtrans - - tau = math_mul33xx33(Mp,prm%Schmid_trans(1:3,1:3,i)) - - significantTransStress: if (tau > tol_math_check) then - StressRatio_s = (mse%threshold_stress_trans(i,of)/tau)**prm%s(i) - isFCCtrans: if (prm%isFCC) then - s1=prm%fcc_twinNucleationSlipPair(1,i) - s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau < mse%tau_r_trans(i,of)) then - Ndot0_trans=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_trans*prm%burgers_slip(i))*(1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_trans(i,of)-tau))) - else - Ndot0_trans=0.0_pReal - end if - else isFCCtrans - Ndot0_trans=prm%Ndot0_trans(i) - endif isFCCtrans - dot%strainTransFraction(i,of) = f_unrotated * & - mse%martensiteVolume(i,of)*Ndot0_trans*exp(-StressRatio_s) - !* Dotstate for accumulated shear due to transformation - !dot%accshear_trans(i,of) = dot%strainTransFraction(i,of) * & - ! lattice_sheartrans(index_myfamily+i,ph) - endif significantTransStress - - enddo transState + call kinetics_trans(Mp,temperature,gdot_slip,instance,of,gdot_trans) + dot%twinFraction(:,of) = f_unrotated*gdot_trans end associate + end subroutine plastic_dislotwin_dotState !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on slip systems +!> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau_slip) +subroutine plastic_dislotwin_dependentState(temperature,instance,of) + use math, only: & + PI + + implicit none + integer(pInt), intent(in) :: & + instance, & !< component-ID of integration point + of + real(pReal), intent(in) :: & + temperature !< temperature at IP + + integer(pInt) :: & + i + real(pReal) :: & + sumf_twin,SFE,sumf_trans + real(pReal), dimension(:), allocatable :: & + x0, & + fOverStacksize, & + ftransOverLamellarSize + + + associate(prm => param(instance),& + stt => state(instance),& + dst => microstructure(instance)) + + sumf_twin = sum(stt%twinFraction(1:prm%totalNtwin,of)) + sumf_trans = sum(stt%strainTransFraction(1:prm%totalNtrans,of)) + + sfe = prm%SFE_0K + prm%dSFE_dT * Temperature + + !* rescaled volume fraction for topology + fOverStacksize = stt%twinFraction(1_pInt:prm%totalNtwin,of)/prm%twinsize !ToDo: this is per system + ftransOverLamellarSize = sumf_trans/prm%lamellarsize !ToDo: But this not ... + !Todo: Physically ok, but naming could be adjusted + + + !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation + forall (i = 1_pInt:prm%totalNslip) & + dst%invLambdaSlip(i,of) = & + sqrt(dot_product((stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of)),& + prm%forestProjection(1:prm%totalNslip,i)))/prm%CLambdaSlip(i) + + !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation + if (prm%totalNtwin > 0_pInt .and. prm%totalNslip > 0_pInt) & + dst%invLambdaSlipTwin(1_pInt:prm%totalNslip,of) = & + matmul(prm%interaction_SlipTwin,fOverStacksize)/(1.0_pReal-sumf_twin) + + !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + + !ToDo: needed? if (prm%totalNtwin > 0_pInt) & + dst%invLambdaTwin(1_pInt:prm%totalNtwin,of) = matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) + + + !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation + if (prm%totalNtrans > 0_pInt .and. prm%totalNslip > 0_pInt) & + dst%invLambdaSlipTrans(1_pInt:prm%totalNslip,of) = & ! ToDo: does not work if Ntrans is not 12 + matmul(prm%interaction_SlipTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) + + !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) + !ToDo: needed? if (prm%totalNtrans > 0_pInt) & + dst%invLambdaTrans(1_pInt:prm%totalNtrans,of) = matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) + + !* mean free path between 2 obstacles seen by a moving dislocation + do i = 1_pInt,prm%totalNslip + if ((prm%totalNtwin > 0_pInt) .or. (prm%totalNtrans > 0_pInt)) then ! ToDo: This is too simplified + dst%mfp_slip(i,of) = & + prm%GrainSize/(1.0_pReal+prm%GrainSize*& + (dst%invLambdaSlip(i,of) + dst%invLambdaSlipTwin(i,of) + dst%invLambdaSlipTrans(i,of))) + else + dst%mfp_slip(i,of) = prm%GrainSize & + / (1.0_pReal+prm%GrainSize*dst%invLambdaSlip(i,of)) !!!!!! correct? + endif + enddo + + !* mean free path between 2 obstacles seen by a growing twin/martensite + dst%mfp_twin(:,of) = prm%Cmfptwin*prm%GrainSize/ (1.0_pReal+prm%GrainSize*dst%invLambdaTwin(:,of)) + dst%mfp_trans(:,of) = prm%Cmfptrans*prm%GrainSize/(1.0_pReal+prm%GrainSize*dst%invLambdaTrans(:,of)) + + !* threshold stress for dislocation motion + forall (i = 1_pInt:prm%totalNslip) dst%threshold_stress_slip(i,of) = & + prm%mu*prm%burgers_slip(i)*& + sqrt(dot_product(stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of),& + prm%interaction_SlipSlip(i,1:prm%totalNslip))) + + !* threshold stress for growing twin/martensite + if(prm%totalNtwin == prm%totalNslip) & + dst%threshold_stress_twin(:,of) = prm%Cthresholdtwin* & + (sfe/(3.0_pReal*prm%burgers_twin)+ 3.0_pReal*prm%burgers_twin*prm%mu/ & + (prm%L0_twin*prm%burgers_slip)) ! slip burgers here correct? + if(prm%totalNtrans == prm%totalNslip) & + dst%threshold_stress_trans(:,of) = prm%Cthresholdtrans* & + (sfe/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& + (prm%L0_trans*prm%burgers_slip) + prm%transStackHeight*prm%deltaG/ (3.0_pReal*prm%burgers_trans) ) + + + dst%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*dst%mfp_twin(:,of)**2.0_pReal + dst%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsize*dst%mfp_trans(:,of)**2.0_pReal + + + x0 = prm%mu*prm%burgers_twin**2.0_pReal/(SFE*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) + dst%tau_r_twin(:,of) = prm%mu*prm%burgers_twin/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) + + x0 = prm%mu*prm%burgers_trans**2.0_pReal/(SFE*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) + dst%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) + + end associate + +end subroutine plastic_dislotwin_dependentState + + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postResults) + use prec, only: & + tol_math_check, & + dEq0 + use math, only: & + PI, & + math_mul33xx33 + + implicit none + real(pReal), dimension(3,3),intent(in) :: & + Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), intent(in) :: & + temperature !< temperature at integration point + integer(pInt), intent(in) :: & + instance, & + of + + real(pReal), dimension(sum(plastic_dislotwin_sizePostResult(:,instance))) :: & + postResults + + integer(pInt) :: & + o,c,j + + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) + + c = 0_pInt + + do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + + case (edge_density_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdge(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (dipole_density_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (shear_rate_slip_ID) + call kinetics_slip(Mp,temperature,instance,of,postResults(c+1:c+prm%totalNslip)) + c = c + prm%totalNslip + case (accumulated_shear_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (mfp_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = dst%mfp_slip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (resolved_stress_slip_ID) + do j = 1_pInt, prm%totalNslip + postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) + enddo + c = c + prm%totalNslip + case (threshold_stress_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = dst%threshold_stress_slip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + + case (twin_fraction_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%twinFraction(1_pInt:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (mfp_twin_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = dst%mfp_twin(1_pInt:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (resolved_stress_twin_ID) + do j = 1_pInt, prm%totalNtwin + postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) + enddo + c = c + prm%totalNtwin + case (threshold_stress_twin_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = dst%threshold_stress_twin(1_pInt:prm%totalNtwin,of) + c = c + prm%totalNtwin + + case (strain_trans_fraction_ID) + postResults(c+1_pInt:c+prm%totalNtrans) = stt%strainTransFraction(1_pInt:prm%totalNtrans,of) + c = c + prm%totalNtrans + end select + enddo + + end associate + +end function plastic_dislotwin_postResults + + +!-------------------------------------------------------------------------------------------------- +!> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the +! resolved stresss +!> @details Derivatives and resolved stress are calculated only optionally. +! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to +! have the optional arguments at the end +!-------------------------------------------------------------------------------------------------- +pure subroutine kinetics_slip(Mp,Temperature,instance,of, & + gdot_slip,dgdot_dtau_slip,tau_slip) use prec, only: & tol_math_check, & dNeq0 @@ -1270,43 +1121,42 @@ pure subroutine kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tDislotwinState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & of - type(tDislotwinMicrostructure), intent(in) :: & - mse - real(pReal), dimension(prm%totalNslip), intent(out) :: & + + real(pReal), dimension(param(instance)%totalNslip), intent(out) :: & gdot_slip - real(pReal), dimension(prm%totalNslip), optional, intent(out) :: & - dgdot_dtau_slip - real(pReal), dimension(prm%totalNslip) :: & + real(pReal), dimension(param(instance)%totalNslip), optional, intent(out) :: & + dgdot_dtau_slip, & + tau_slip + real(pReal), dimension(param(instance)%totalNslip) :: & dgdot_dtau - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), intent(in) :: & - temperature - real, dimension(prm%totalNslip) :: & + real, dimension(param(instance)%totalNslip) :: & tau, & stressRatio, & StressRatio_p, & BoltzmannRatio, & - v_wait_inverse, & !< inverse of the effective velocity of a dislocation waiting at obstacles (unsigned) - v_run_inverse, & !< inverse of the velocity of a free moving dislocation (unsigned) + v_wait_inverse, & !< inverse of the effective velocity of a dislocation waiting at obstacles (unsigned) + v_run_inverse, & !< inverse of the velocity of a free moving dislocation (unsigned) dV_wait_inverse_dTau, & dV_run_inverse_dTau, & dV_dTau, & - tau_eff !< effective resolved stress + tau_eff !< effective resolved stress integer(pInt) :: i + + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) do i = 1_pInt, prm%totalNslip tau(i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) enddo - tau_eff = abs(tau)-mse%threshold_stress_slip(:,of) + tau_eff = abs(tau)-dst%threshold_stress_slip(:,of) significantStress: where(tau_eff > tol_math_check) stressRatio = tau_eff/(prm%SolidSolutionStrength+prm%tau_peierls) @@ -1330,15 +1180,19 @@ pure subroutine kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau dgdot_dtau = 0.0_pReal end where significantStress + end associate + if(present(dgdot_dtau_slip)) dgdot_dtau_slip = dgdot_dtau - + if(present(tau_slip)) tau_slip = tau + end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on twin systems !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin,dgdot_dtau_twin) +pure subroutine kinetics_twin(Mp,temperature,gdot_slip,instance,of,& + gdot_twin,dgdot_dtau_twin) use prec, only: & tol_math_check, & dNeq0 @@ -1346,71 +1200,71 @@ pure subroutine kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin, math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tDislotwinState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & of - type(tDislotwinMicrostructure), intent(in) :: & - mse - real(pReal), dimension(prm%totalNslip), intent(out) :: & + real(pReal), dimension(param(instance)%totalNslip), intent(in) :: & gdot_slip - real(pReal), dimension(prm%totalNtwin), intent(out) :: & + + real(pReal), dimension(param(instance)%totalNtwin), intent(out) :: & gdot_twin - real(pReal), dimension(prm%totalNtwin), optional, intent(out) :: & + real(pReal), dimension(param(instance)%totalNtwin), optional, intent(out) :: & dgdot_dtau_twin - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), intent(in) :: & - temperature - real, dimension(prm%totalNtwin) :: & + real, dimension(param(instance)%totalNtwin) :: & tau, & - Ndot0_twin, & + Ndot0, & stressRatio_r, & dgdot_dtau integer(pInt) :: i,s1,s2 + + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) do i = 1_pInt, prm%totalNtwin tau(i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) - isFCC: if (prm%isFCC) then + isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < mse%tau_r_twin(i,of)) then - Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& + if (tau(i) < dst%tau_r_twin(i,of)) then + Ndot0=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L0_twin*prm%burgers_slip(i))*& (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_twin(i,of)-tau))) + (dst%tau_r_twin(i,of)-tau))) else - Ndot0_twin=0.0_pReal + Ndot0=0.0_pReal end if else isFCC - Ndot0_twin=prm%Ndot0_twin(i) + Ndot0=prm%Ndot0_twin(i) endif isFCC enddo - significantStress: where(tau > tol_math_check) - StressRatio_r = (mse%threshold_stress_twin(:,of)/tau)**prm%r - gdot_twin = prm%shear_twin * mse%twinVolume(:,of) * Ndot0_twin*exp(-StressRatio_r) - dgdot_dtau = ((gdot_twin*prm%r)/tau)*StressRatio_r + StressRatio_r = (dst%threshold_stress_twin(:,of)/tau)**prm%r + gdot_twin = prm%shear_twin * dst%twinVolume(:,of) * Ndot0*exp(-StressRatio_r) + dgdot_dtau = (gdot_twin*prm%r/tau)*StressRatio_r else where significantStress gdot_twin = 0.0_pReal dgdot_dtau = 0.0_pReal end where significantStress + + end associate if(present(dgdot_dtau_twin)) dgdot_dtau_twin = dgdot_dtau end subroutine kinetics_twin - + !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on transformation systems +!> @brief calculates shear rates on twin systems !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_trans(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_trans,dgdot_dtau_trans) +pure subroutine kinetics_trans(Mp,temperature,gdot_slip,instance,of,& + gdot_trans,dgdot_dtau_trans) use prec, only: & tol_math_check, & dNeq0 @@ -1418,281 +1272,63 @@ pure subroutine kinetics_trans(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_tran math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tDislotwinState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & of - type(tDislotwinMicrostructure), intent(in) :: & - mse - real(pReal), dimension(prm%totalNslip), intent(out) :: & + real(pReal), dimension(param(instance)%totalNslip), intent(in) :: & gdot_slip - real(pReal), dimension(prm%totalNtrans), intent(out) :: & + + real(pReal), dimension(param(instance)%totalNtrans), intent(out) :: & gdot_trans - real(pReal), dimension(prm%totalNtrans), optional, intent(out) :: & + real(pReal), dimension(param(instance)%totalNtrans), optional, intent(out) :: & dgdot_dtau_trans - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), intent(in) :: & - temperature - real, dimension(prm%totalNtrans) :: & + real, dimension(param(instance)%totalNtrans) :: & tau, & - Ndot0_trans, & - stressRatio_r, & + Ndot0, & + stressRatio_s, & dgdot_dtau integer(pInt) :: i,s1,s2 + + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) do i = 1_pInt, prm%totalNtrans tau(i) = math_mul33xx33(Mp,prm%Schmid_trans(1:3,1:3,i)) - isFCC: if (prm%isFCC) then + isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < mse%tau_r_trans(i,of)) then - Ndot0_trans=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_trans*prm%burgers_slip(i))*& ! burgers_slip correct? + if (tau(i) < dst%tau_r_trans(i,of)) then + Ndot0=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state + (prm%L0_trans*prm%burgers_slip(i))*& (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_trans(i,of)-tau))) + (dst%tau_r_trans(i,of)-tau))) else - Ndot0_trans=0.0_pReal + Ndot0=0.0_pReal end if else isFCC - Ndot0_trans=prm%Ndot0_trans(i) + Ndot0=prm%Ndot0_trans(i) endif isFCC enddo -! -! -! endif isFCCtrans -! dot%strainTransFraction(i,of) = f_unrotated * & -! mse%martensiteVolume(i,of)*Ndot0_trans*exp(-StressRatio_s) -! !* Dotstate for accumulated shear due to transformation -! !dot%accshear_trans(i,of) = dot%strainTransFraction(i,of) * & -! ! lattice_sheartrans(index_myfamily+i,ph) -! endif significantTransStress -! -! enddo transState -! -! -! significantStress: where(tau > tol_math_check) -! StressRatio_r = (mse%threshold_stress_twin(:,of)/tau)**prm%r -! gdot_twin = prm%shear_twin * mse%twinVolume(:,of) * Ndot0_twin*exp(-StressRatio_r) -! dgdot_dtau = ((gdot_twin*prm%r)/tau)*StressRatio_r -! else where significantStress -! gdot_twin = 0.0_pReal -! dgdot_dtau = 0.0_pReal -! end where significantStress -! -! if(present(dgdot_dtau_twin)) dgdot_dtau_twin = dgdot_dtau -! + + significantStress: where(tau > tol_math_check) + StressRatio_s = (dst%threshold_stress_trans(:,of)/tau)**prm%s + gdot_trans = dst%martensiteVolume(:,of) * Ndot0*exp(-StressRatio_s) + dgdot_dtau = (gdot_trans*prm%r/tau)*StressRatio_s + else where significantStress + gdot_trans = 0.0_pReal + dgdot_dtau = 0.0_pReal + end where significantStress + + end associate + + if(present(dgdot_dtau_trans)) dgdot_dtau_trans = dgdot_dtau + end subroutine kinetics_trans -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postResults) - use prec, only: & - tol_math_check, & - dEq0 - use math, only: & - PI, & - math_mul33xx33, & - math_Mandel6to33 - use material, only: & - material_phase, & - plasticState, & - phase_plasticityInstance,& - phasememberAt - - implicit none - real(pReal), dimension(3,3),intent(in) :: & - Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at integration point - integer(pInt), intent(in) :: & - instance, & - of - - real(pReal), dimension(sum(plastic_dislotwin_sizePostResult(:,instance))) :: & - postResults - - integer(pInt) :: & - o,c,j,& - s1,s2 - real(pReal) :: sumf_twin,tau,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,StressRatio_r,Ndot0_twin,dgdot_dtauslip, & - stressRatio - real(pReal), dimension(param(instance)%totalNslip) :: & - gdot_slip - - type(tParameters) :: prm - type(tDislotwinState) :: stt - type(tDislotwinMicrostructure) :: mse - - - associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) - - sumf_twin = sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) - - c = 0_pInt - postResults = 0.0_pReal - do o = 1_pInt,size(prm%outputID) - select case(prm%outputID(o)) - - case (edge_density_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdge(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (dipole_density_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (shear_rate_slip_ID) - call kinetics_slip(prm,stt,mse,of,Mp,temperature,postResults(c+1:c+prm%totalNslip)) - c = c + prm%totalNslip - case (accumulated_shear_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (mfp_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%mfp_slip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (resolved_stress_slip_ID) - do j = 1_pInt, prm%totalNslip - postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - enddo - c = c + prm%totalNslip - case (threshold_stress_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%threshold_stress_slip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (edge_dipole_distance_ID) - do j = 1_pInt, prm%totalNslip - postResults(c+j) = (3.0_pReal*prm%mu*prm%burgers_slip(j)) & - / (16.0_pReal*PI*abs(math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)))) - postResults(c+j)=min(postResults(c+j),mse%mfp_slip(j,of)) - ! postResults(c+j)=max(postResults(c+j),& - ! plasticState(ph)%state(4*ns+2*nt+2*nr+j, of)) - enddo - c = c + prm%totalNslip - ! case (resolved_stress_shearband_ID) - ! do j = 1_pInt,6_pInt ! loop over all shearband families - ! postResults(c+j) = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) - ! enddo - ! c = c + 6_pInt - ! case (shear_rate_shearband_ID) - ! do j = 1_pInt,6_pInt ! loop over all shearbands - ! tau = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) - ! if (abs(tau) < tol_math_check) then - ! StressRatio_p = 0.0_pReal - ! StressRatio_pminus1 = 0.0_pReal - ! else - ! StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand - ! StressRatio_pminus1 = (abs(tau)/prm%sbResistance)**(prm%pShearBand-1.0_pReal) - ! endif - ! BoltzmannRatio = prm%sbQedge/(kB*Temperature) - ! DotGamma0 = prm%sbVelocity - ! postResults(c+j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**prm%qShearBand)*& - ! sign(1.0_pReal,tau) - ! enddo - ! c = c + 6_pInt - case (twin_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%twinFraction(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (shear_rate_twin_ID) - do j = 1_pInt, prm%totalNslip - tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then - StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **prm%p(j) - StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **(prm%p(j)-1.0_pReal) - BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) - - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& - prm%q(j))*sign(1.0_pReal,tau) - else - gdot_slip(j) = 0.0_pReal - endif - enddo - - do j = 1_pInt, prm%totalNtwin - tau = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) - - if ( tau > 0.0_pReal ) then - isFCCtwin: if (prm%isFCC) then - s1=prm%fcc_twinNucleationSlipPair(1,j) - s2=prm%fcc_twinNucleationSlipPair(2,j) - if (tau < mse%tau_r_twin(j,of)) then - Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_twin* prm%burgers_slip(j))*& - (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)* (mse%tau_r_twin(j,of)-tau))) - else - Ndot0_twin=0.0_pReal - end if - else isFCCtwin - Ndot0_twin=prm%Ndot0_twin(j) - endif isFCCtwin - StressRatio_r = (mse%threshold_stress_twin(j,of)/tau) **prm%r(j) - postResults(c+j) = (prm%MaxTwinFraction-sumf_twin)*prm%shear_twin(j) & - * mse%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) - endif - enddo - c = c + prm%totalNtwin - case (accumulated_shear_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (mfp_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = mse%mfp_twin(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (resolved_stress_twin_ID) - do j = 1_pInt, prm%totalNtwin - postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) - enddo - c = c + prm%totalNtwin - case (threshold_stress_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = mse%threshold_stress_twin(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (stress_exponent_ID) - do j = 1_pInt, prm%totalNslip - tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then - StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **prm%p(j) - StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **(prm%p(j)-1.0_pReal) - BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) - - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& - prm%q(j))*sign(1.0_pReal,tau) - - dgdot_dtauslip = abs(gdot_slip(j))*BoltzmannRatio*prm%p(j) *prm%q(j)/& - (prm%SolidSolutionStrength+ prm%tau_peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) - else - gdot_slip(j) = 0.0_pReal - dgdot_dtauslip = 0.0_pReal - endif - postResults(c+j) = merge(0.0_pReal,(tau/gdot_slip(j))*dgdot_dtauslip,dEq0(gdot_slip(j))) - enddo - c = c + prm%totalNslip - case (stress_trans_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtrans) = stt%stressTransFraction(1_pInt:prm%totalNtrans,of) - c = c + prm%totalNtrans - case (strain_trans_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtrans) = stt%strainTransFraction(1_pInt:prm%totalNtrans,of) - c = c + prm%totalNtrans - end select - enddo - end associate -end function plastic_dislotwin_postResults - end module plastic_dislotwin diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 690349c96..be4261b03 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -151,7 +151,6 @@ subroutine plastic_kinehardening_init outputID character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs @@ -187,8 +186,6 @@ subroutine plastic_kinehardening_init endif #endif - structure = config%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! optional parameters that need to be defined prm%aTolResistance = config%getFloat('atol_resistance',defaultVal=1.0_pReal) @@ -203,28 +200,29 @@ subroutine plastic_kinehardening_init prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - if(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%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) else - prm%nonSchmid_pos = prm%Schmid - prm%nonSchmid_neg = prm%Schmid + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid endif prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - structure(1:3)) + config%getString('lattice_structure')) - prm%crss0 = config%getFloats('crss0', requiredShape=shape(prm%Nslip)) - prm%tau1 = config%getFloats('tau1', requiredShape=shape(prm%Nslip)) - prm%tau1_b = config%getFloats('tau1_b', requiredShape=shape(prm%Nslip)) - prm%theta0 = config%getFloats('theta0', requiredShape=shape(prm%Nslip)) - prm%theta1 = config%getFloats('theta1', requiredShape=shape(prm%Nslip)) - prm%theta0_b = config%getFloats('theta0_b', requiredShape=shape(prm%Nslip)) - prm%theta1_b = config%getFloats('theta1_b', requiredShape=shape(prm%Nslip)) + prm%crss0 = config%getFloats('crss0', requiredSize=size(prm%Nslip)) + prm%tau1 = config%getFloats('tau1', requiredSize=size(prm%Nslip)) + prm%tau1_b = config%getFloats('tau1_b', requiredSize=size(prm%Nslip)) + prm%theta0 = config%getFloats('theta0', requiredSize=size(prm%Nslip)) + prm%theta1 = config%getFloats('theta1', requiredSize=size(prm%Nslip)) + prm%theta0_b = config%getFloats('theta0_b', requiredSize=size(prm%Nslip)) + prm%theta1_b = config%getFloats('theta1_b', requiredSize=size(prm%Nslip)) prm%gdot0 = config%getFloat('gdot0') prm%n = config%getFloat('n_slip') @@ -302,7 +300,6 @@ subroutine plastic_kinehardening_init call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,sizeDeltaState, & prm%totalNslip,0_pInt,0_pInt) plasticState(p)%sizePostResults = sum(plastic_kinehardening_sizePostResult(:,phase_plasticityInstance(p))) - plasticState(p)%offsetDeltaState = sizeDotState !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 0fe0f51e8..fd40f12da 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -153,7 +153,6 @@ subroutine plastic_phenopowerlaw_init outputID character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs @@ -181,8 +180,6 @@ subroutine plastic_phenopowerlaw_init stt => state(phase_plasticityInstance(p)), & config => config_phase(p)) - structure = config%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! optional parameters that need to be defined prm%twinB = config%getFloat('twin_b',defaultVal=1.0_pReal) @@ -204,30 +201,31 @@ subroutine plastic_phenopowerlaw_init prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - if(structure=='bcc') then - prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + prm%Schmid_slip = 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_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) else - prm%nonSchmid_pos = prm%Schmid_slip - prm%nonSchmid_neg = prm%Schmid_slip + prm%nonSchmid_pos = prm%Schmid_slip + prm%nonSchmid_neg = prm%Schmid_slip endif prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - structure(1:3)) + config%getString('lattice_structure')) - prm%xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(prm%Nslip)) - prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip)) - prm%H_int = config%getFloats('h_int', requiredSize=size(prm%Nslip), & - defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(prm%Nslip)) + prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip)) + prm%H_int = config%getFloats('h_int', requiredSize=size(prm%Nslip), & + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%gdot0_slip = config%getFloat('gdot0_slip') - prm%n_slip = config%getFloat('n_slip') - prm%a_slip = config%getFloat('a_slip') - prm%h0_SlipSlip = config%getFloat('h0_slipslip') + prm%gdot0_slip = config%getFloat('gdot0_slip') + prm%n_slip = config%getFloat('n_slip') + prm%a_slip = config%getFloat('a_slip') + prm%h0_SlipSlip = config%getFloat('h0_slipslip') ! expand: family => system prm%xi_slip_0 = math_expand(prm%xi_slip_0, prm%Nslip) @@ -250,12 +248,12 @@ subroutine plastic_phenopowerlaw_init prm%Ntwin = config%getInts('ntwin', defaultVal=emptyIntArray) prm%totalNtwin = sum(prm%Ntwin) twinActive: if (prm%totalNtwin > 0_pInt) then - prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,structure(1:3),& + prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,& config%getFloats('interaction_twintwin'), & - structure(1:3)) - prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,structure(1:3),& + config%getString('lattice_structure')) + prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a')) prm%xi_twin_0 = config%getFloats('tau0_twin',requiredSize=size(prm%Ntwin)) @@ -282,10 +280,10 @@ subroutine plastic_phenopowerlaw_init slipAndTwinActive: if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,& config%getFloats('interaction_sliptwin'), & - structure(1:3)) + config%getString('lattice_structure')) prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,& config%getFloats('interaction_twinslip'), & - structure(1:3)) + config%getString('lattice_structure')) else slipAndTwinActive allocate(prm%interaction_SlipTwin(prm%totalNslip,prm%TotalNtwin)) ! at least one dimension is 0 allocate(prm%interaction_TwinSlip(prm%totalNtwin,prm%TotalNslip)) ! at least one dimension is 0