From 0880649dd9c3d287659893443a7bad52fb5ae7e4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 23 Jan 2023 08:31:59 +0100 Subject: [PATCH] more systematic name --- src/homogenization.f90 | 10 +++--- src/homogenization_damage.f90 | 12 +++---- src/homogenization_mechanical.f90 | 18 +++++----- src/homogenization_mechanical_RGC.f90 | 14 ++++---- src/homogenization_mechanical_isostrain.f90 | 2 +- src/homogenization_mechanical_pass.f90 | 2 +- src/homogenization_thermal.f90 | 24 ++++++------- src/material.f90 | 28 +++++++-------- src/phase.f90 | 28 +++++++-------- src/phase_damage.f90 | 24 ++++++------- src/phase_damage_anisobrittle.f90 | 2 +- src/phase_damage_isobrittle.f90 | 2 +- src/phase_mechanical.f90 | 32 ++++++++--------- ...phase_mechanical_plastic_dislotungsten.f90 | 2 +- src/phase_mechanical_plastic_dislotwin.f90 | 2 +- src/phase_mechanical_plastic_isotropic.f90 | 2 +- ...phase_mechanical_plastic_kinehardening.f90 | 2 +- src/phase_mechanical_plastic_none.f90 | 2 +- src/phase_mechanical_plastic_nonlocal.f90 | 34 +++++++++---------- ...phase_mechanical_plastic_phenopowerlaw.f90 | 2 +- src/phase_thermal.f90 | 12 +++---- src/phase_thermal_dissipation.f90 | 2 +- src/phase_thermal_externalheat.f90 | 2 +- 23 files changed, 130 insertions(+), 130 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 9f9b92bec..778a094b4 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -250,8 +250,8 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end) !$OMP PARALLEL DO PRIVATE(en,ho,co,NiterationMPstate,converged,doneAndHappy) do ce = cell_start, cell_end - en = material_homogenizationEntry(ce) - ho = material_homogenizationID(ce) + en = material_entry_homogenization(ce) + ho = material_ID_homogenization(ce) call phase_restore(ce,.false.) ! wrong name (is more a forward function) @@ -303,9 +303,9 @@ subroutine homogenization_thermal_response(Delta_t,cell_start,cell_end) !$OMP PARALLEL DO PRIVATE(ho) do ce = cell_start, cell_end if (terminallyIll) continue - ho = material_homogenizationID(ce) + ho = material_ID_homogenization(ce) do co = 1, homogenization_Nconstituents(ho) - if (.not. phase_thermal_constitutive(Delta_t,material_phaseID(co,ce),material_phaseEntry(co,ce))) then + if (.not. phase_thermal_constitutive(Delta_t,material_ID_phase(co,ce),material_entry_phase(co,ce))) then if (.not. terminallyIll) print*, ' Cell ', ce, ' terminally ill' terminallyIll = .true. end if @@ -333,7 +333,7 @@ subroutine homogenization_mechanical_response2(Delta_t,FEsolving_execIP,FEsolvin elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) ce = (el-1)*discretization_nIPs + ip - ho = material_homogenizationID(ce) + ho = material_ID_homogenization(ce) do co = 1, homogenization_Nconstituents(ho) call crystallite_orientations(co,ip,el) end do diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index ffd07f1ef..703f546d0 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -47,7 +47,7 @@ module subroutine damage_init() allocate(current(configHomogenizations%length)) do ho = 1, configHomogenizations%length - Nmembers = count(material_homogenizationID == ho) + Nmembers = count(material_ID_homogenization == ho) allocate(current(ho)%phi(Nmembers), source=1.0_pReal) configHomogenization => configHomogenizations%get_dict(ho) associate(prm => param(ho)) @@ -95,9 +95,9 @@ module subroutine damage_partition(ce) integer :: co - if (damageState_h(material_homogenizationID(ce))%sizeState < 1) return - phi = damagestate_h(material_homogenizationID(ce))%state(1,material_homogenizationEntry(ce)) - do co = 1, homogenization_Nconstituents(material_homogenizationID(ce)) + if (damageState_h(material_ID_homogenization(ce))%sizeState < 1) return + phi = damagestate_h(material_ID_homogenization(ce))%state(1,material_entry_homogenization(ce)) + do co = 1, homogenization_Nconstituents(material_ID_homogenization(ce)) call phase_set_phi(phi,co,ce) end do @@ -161,8 +161,8 @@ module subroutine homogenization_set_phi(phi,ce) en - ho = material_homogenizationID(ce) - en = material_homogenizationEntry(ce) + ho = material_ID_homogenization(ce) + en = material_entry_homogenization(ce) damagestate_h(ho)%state(1,en) = phi current(ho)%phi(en) = phi diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90 index eb5ec75a4..24625769e 100644 --- a/src/homogenization_mechanical.f90 +++ b/src/homogenization_mechanical.f90 @@ -99,10 +99,10 @@ module subroutine mechanical_partition(subF,ce) ce integer :: co - real(pReal), dimension (3,3,homogenization_Nconstituents(material_homogenizationID(ce))) :: Fs + real(pReal), dimension (3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) :: Fs - chosenHomogenization: select case(mechanical_type(material_homogenizationID(ce))) + chosenHomogenization: select case(mechanical_type(material_ID_homogenization(ce))) case (MECHANICAL_PASS_ID) chosenHomogenization Fs(1:3,1:3,1) = subF @@ -115,7 +115,7 @@ module subroutine mechanical_partition(subF,ce) end select chosenHomogenization - do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) + do co = 1,homogenization_Nconstituents(material_ID_homogenization(ce)) call phase_set_F(Fs(1:3,1:3,co),co,ce) end do @@ -136,7 +136,7 @@ module subroutine mechanical_homogenize(Delta_t,ce) homogenization_P(1:3,1:3,ce) = phase_P(1,ce)*material_v(1,ce) homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = phase_mechanical_dPdF(Delta_t,1,ce)*material_v(1,ce) - do co = 2, homogenization_Nconstituents(material_homogenizationID(ce)) + do co = 2, homogenization_Nconstituents(material_ID_homogenization(ce)) homogenization_P(1:3,1:3,ce) = homogenization_P(1:3,1:3,ce) & + phase_P(co,ce)*material_v(co,ce) homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = homogenization_dPdF(1:3,1:3,1:3,1:3,ce) & @@ -161,13 +161,13 @@ module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy) logical, dimension(2) :: doneAndHappy integer :: co - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationID(ce))) - real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationID(ce))) - real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationID(ce))) + real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) + real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) + real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) - if (mechanical_type(material_homogenizationID(ce)) == MECHANICAL_RGC_ID) then - do co = 1, homogenization_Nconstituents(material_homogenizationID(ce)) + if (mechanical_type(material_ID_homogenization(ce)) == MECHANICAL_RGC_ID) then + do co = 1, homogenization_Nconstituents(material_ID_homogenization(ce)) dPdFs(:,:,:,:,co) = phase_mechanical_dPdF(subdt,co,ce) Fs(:,:,co) = phase_F(co,ce) Ps(:,:,co) = phase_P(co,ce) diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index 8d56a26f2..0e85fcca6 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -162,7 +162,7 @@ module subroutine RGC_init() prm%D_alpha = homogMech%get_as1dFloat('D_alpha', requiredSize=3) prm%a_g = homogMech%get_as1dFloat('a_g', requiredSize=3) - Nmembers = count(material_homogenizationID == ho) + Nmembers = count(material_ID_homogenization == ho) nIntFaceTot = 3*( (prm%N_constituents(1)-1)*prm%N_constituents(2)*prm%N_constituents(3) & + prm%N_constituents(1)*(prm%N_constituents(2)-1)*prm%N_constituents(3) & + prm%N_constituents(1)*prm%N_constituents(2)*(prm%N_constituents(3)-1)) @@ -208,10 +208,10 @@ module subroutine RGC_partitionDeformation(F,avgF,ce) integer, dimension(3) :: iGrain3 integer :: iGrain,iFace,i,j,ho,en - associate(prm => param(material_homogenizationID(ce))) + associate(prm => param(material_ID_homogenization(ce))) - ho = material_homogenizationID(ce) - en = material_homogenizationEntry(ce) + ho = material_ID_homogenization(ce) + en = material_entry_homogenization(ce) !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations F = 0.0_pReal @@ -263,8 +263,8 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) return end if zeroTimeStep - ho = material_homogenizationID(ce) - en = material_homogenizationEntry(ce) + ho = material_ID_homogenization(ce) + en = material_entry_homogenization(ce) associate(stt => state(ho), st0 => state0(ho), dst => dependentState(ho), prm => param(ho)) @@ -652,7 +652,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) real(pReal), dimension(6,6) :: C - C = phase_homogenizedC66(material_phaseID(co,ce),material_phaseEntry(co,ce)) ! damage not included! + C = phase_homogenizedC66(material_ID_phase(co,ce),material_entry_phase(co,ce)) ! damage not included! equivalentMu = lattice_isotropic_mu(C,'isostrain') diff --git a/src/homogenization_mechanical_isostrain.f90 b/src/homogenization_mechanical_isostrain.f90 index 72aed0166..3a603196f 100644 --- a/src/homogenization_mechanical_isostrain.f90 +++ b/src/homogenization_mechanical_isostrain.f90 @@ -25,7 +25,7 @@ module subroutine isostrain_init do ho = 1, size(mechanical_type) if (mechanical_type(ho) /= MECHANICAL_ISOSTRAIN_ID) cycle - Nmembers = count(material_homogenizationID == ho) + Nmembers = count(material_ID_homogenization == ho) homogState(ho)%sizeState = 0 allocate(homogState(ho)%state0(0,Nmembers)) allocate(homogState(ho)%state (0,Nmembers)) diff --git a/src/homogenization_mechanical_pass.f90 b/src/homogenization_mechanical_pass.f90 index 38d961562..f3c79107f 100644 --- a/src/homogenization_mechanical_pass.f90 +++ b/src/homogenization_mechanical_pass.f90 @@ -28,7 +28,7 @@ module subroutine pass_init() if (homogenization_Nconstituents(ho) /= 1) & call IO_error(211,ext_msg='(pass) with N_constituents !=1') - Nmembers = count(material_homogenizationID == ho) + Nmembers = count(material_ID_homogenization == ho) homogState(ho)%sizeState = 0 allocate(homogState(ho)%state0(0,Nmembers)) allocate(homogState(ho)%state (0,Nmembers)) diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index 401a7df81..edba596c8 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -50,8 +50,8 @@ module subroutine thermal_init() allocate(current(configHomogenizations%length)) do ho = 1, configHomogenizations%length - allocate(current(ho)%T(count(material_homogenizationID==ho)), source=T_ROOM) - allocate(current(ho)%dot_T(count(material_homogenizationID==ho)), source=0.0_pReal) + allocate(current(ho)%T(count(material_ID_homogenization==ho)), source=T_ROOM) + allocate(current(ho)%dot_T(count(material_ID_homogenization==ho)), source=0.0_pReal) configHomogenization => configHomogenizations%get_dict(ho) associate(prm => param(ho)) @@ -104,9 +104,9 @@ module subroutine thermal_partition(ce) integer :: co - T = current(material_homogenizationID(ce))%T(material_homogenizationEntry(ce)) - dot_T = current(material_homogenizationID(ce))%dot_T(material_homogenizationEntry(ce)) - do co = 1, homogenization_Nconstituents(material_homogenizationID(ce)) + T = current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) + dot_T = current(material_ID_homogenization(ce))%dot_T(material_entry_homogenization(ce)) + do co = 1, homogenization_Nconstituents(material_ID_homogenization(ce)) call phase_thermal_setField(T,dot_T,co,ce) end do @@ -125,7 +125,7 @@ module function homogenization_mu_T(ce) result(mu) mu = phase_mu_T(1,ce)*material_v(1,ce) - do co = 2, homogenization_Nconstituents(material_homogenizationID(ce)) + do co = 2, homogenization_Nconstituents(material_ID_homogenization(ce)) mu = mu + phase_mu_T(co,ce)*material_v(co,ce) end do @@ -144,7 +144,7 @@ module function homogenization_K_T(ce) result(K) K = phase_K_T(1,ce)*material_v(1,ce) - do co = 2, homogenization_Nconstituents(material_homogenizationID(ce)) + do co = 2, homogenization_Nconstituents(material_ID_homogenization(ce)) K = K + phase_K_T(co,ce)*material_v(co,ce) end do @@ -162,9 +162,9 @@ module function homogenization_f_T(ce) result(f) integer :: co - f = phase_f_T(material_phaseID(1,ce),material_phaseEntry(1,ce))*material_v(1,ce) - do co = 2, homogenization_Nconstituents(material_homogenizationID(ce)) - f = f + phase_f_T(material_phaseID(co,ce),material_phaseEntry(co,ce))*material_v(co,ce) + f = phase_f_T(material_ID_phase(1,ce),material_entry_phase(1,ce))*material_v(1,ce) + do co = 2, homogenization_Nconstituents(material_ID_homogenization(ce)) + f = f + phase_f_T(material_ID_phase(co,ce),material_entry_phase(co,ce))*material_v(co,ce) end do end function homogenization_f_T @@ -179,8 +179,8 @@ module subroutine homogenization_thermal_setField(T,dot_T, ce) real(pReal), intent(in) :: T, dot_T - current(material_homogenizationID(ce))%T(material_homogenizationEntry(ce)) = T - current(material_homogenizationID(ce))%dot_T(material_homogenizationEntry(ce)) = dot_T + current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) = T + current(material_ID_homogenization(ce))%dot_T(material_entry_homogenization(ce)) = dot_T call thermal_partition(ce) end subroutine homogenization_thermal_setField diff --git a/src/material.f90 b/src/material.f90 index 991912fdd..791996730 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -39,11 +39,11 @@ module material material_name_homogenization !< name of each homogenization integer, dimension(:), allocatable, public, protected :: & ! (cell) - material_homogenizationID, & ! TODO: rename to material_ID_homogenization - material_homogenizationEntry ! TODO: rename to material_entry_homogenization + material_ID_homogenization, & !< Number of the homogenization + material_entry_homogenization !< Position in array of used homogenization integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,cell) - material_phaseID, & ! TODO: rename to material_ID_phase - material_phaseEntry ! TODO: rename to material_entry_phase + material_ID_phase, & !< Number of the phase + material_entry_phase !< Position in array of used phase real(pReal), dimension(:,:), allocatable, public, protected :: & material_v ! fraction @@ -70,8 +70,8 @@ subroutine material_init(restart) if (.not. restart) then call result_openJobFile - call result_mapping_phase(material_phaseID,material_phaseEntry,material_name_phase) - call result_mapping_homogenization(material_homogenizationID,material_homogenizationEntry,material_name_homogenization) + call result_mapping_phase(material_ID_phase,material_entry_phase,material_name_phase) + call result_mapping_homogenization(material_ID_homogenization,material_entry_homogenization,material_name_homogenization) call result_closeJobFile end if @@ -166,11 +166,11 @@ subroutine parse() allocate(counterPhase(phases%length),source=0) allocate(counterHomogenization(homogenizations%length),source=0) - allocate(material_homogenizationID(discretization_Ncells),source=0) - allocate(material_homogenizationEntry(discretization_Ncells),source=0) + allocate(material_ID_homogenization(discretization_Ncells),source=0) + allocate(material_entry_homogenization(discretization_Ncells),source=0) - allocate(material_phaseID(homogenization_maxNconstituents,discretization_Ncells),source=0) - allocate(material_phaseEntry(homogenization_maxNconstituents,discretization_Ncells),source=0) + allocate(material_ID_phase(homogenization_maxNconstituents,discretization_Ncells),source=0) + allocate(material_entry_phase(homogenization_maxNconstituents,discretization_Ncells),source=0) ! build mappings @@ -181,9 +181,9 @@ subroutine parse() do ip = 1, discretization_nIPs ce = (el-1)*discretization_nIPs + ip - material_homogenizationID(ce) = ho + material_ID_homogenization(ce) = ho counterHomogenization(ho) = counterHomogenization(ho) + 1 - material_homogenizationEntry(ce) = counterHomogenization(ho) + material_entry_homogenization(ce) = counterHomogenization(ho) end do do co = 1, size(ph_of(ma,:)>0) @@ -193,9 +193,9 @@ subroutine parse() do ip = 1, discretization_nIPs ce = (el-1)*discretization_nIPs + ip - material_phaseID(co,ce) = ph + material_ID_phase(co,ce) = ph counterPhase(ph) = counterPhase(ph) + 1 - material_phaseEntry(co,ce) = counterPhase(ph) + material_entry_phase(co,ce) = counterPhase(ph) material_v(co,ce) = v end do diff --git a/src/phase.f90 b/src/phase.f90 index 4d4e30f45..b3ed0f3ca 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -419,14 +419,14 @@ subroutine phase_init if (any(phase_lattice(ph) == ['hP','tI'])) & phase_cOverA(ph) = phase%get_asFloat('c/a') phase_rho(ph) = phase%get_asFloat('rho',defaultVal=0.0_pReal) - allocate(phase_O_0(ph)%data(count(material_phaseID==ph))) + allocate(phase_O_0(ph)%data(count(material_ID_phase==ph))) end do - do ce = 1, size(material_phaseID,2) + do ce = 1, size(material_ID_phase,2) ma = discretization_materialAt((ce-1)/discretization_nIPs+1) - do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) - ph = material_phaseID(co,ce) - phase_O_0(ph)%data(material_phaseEntry(co,ce)) = material_O_0(ma)%data(co) + do co = 1,homogenization_Nconstituents(material_ID_homogenization(ce)) + ph = material_ID_phase(co,ce) + phase_O_0(ph)%data(material_entry_phase(co,ce)) = material_O_0(ma)%data(co) end do end do @@ -586,9 +586,9 @@ subroutine crystallite_init() do el = 1, discretization_Nelems do ip = 1, discretization_nIPs ce = (el-1)*discretization_nIPs + ip - do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) - en = material_phaseEntry(co,ce) - ph = material_phaseID(co,ce) + do co = 1,homogenization_Nconstituents(material_ID_homogenization(ce)) + en = material_entry_phase(co,ce) + ph = material_ID_phase(co,ce) call crystallite_orientations(co,ip,el) call plastic_dependentState(ph,en) ! update dependent state variables to be consistent with basic states end do @@ -613,13 +613,13 @@ subroutine crystallite_orientations(co,ip,el) integer :: ph, en - ph = material_phaseID(co,(el-1)*discretization_nIPs + ip) - en = material_phaseEntry(co,(el-1)*discretization_nIPs + ip) + ph = material_ID_phase(co,(el-1)*discretization_nIPs + ip) + en = material_entry_phase(co,(el-1)*discretization_nIPs + ip) call phase_O(ph)%data(en)%fromMatrix(transpose(math_rotationalPart(mechanical_F_e(ph,en)))) - if (plasticState(material_phaseID(1,(el-1)*discretization_nIPs + ip))%nonlocal) & - call plastic_nonlocal_updateCompatibility(phase_O,material_phaseID(1,(el-1)*discretization_nIPs + ip),ip,el) + if (plasticState(material_ID_phase(1,(el-1)*discretization_nIPs + ip))%nonlocal) & + call plastic_nonlocal_updateCompatibility(phase_O,material_ID_phase(1,(el-1)*discretization_nIPs + ip),ip,el) end subroutine crystallite_orientations @@ -640,8 +640,8 @@ function crystallite_push33ToRef(co,ce, tensor33) integer :: ph, en - ph = material_phaseID(co,ce) - en = material_phaseEntry(co,ce) + ph = material_ID_phase(co,ce) + en = material_entry_phase(co,ce) T = matmul(phase_O_0(ph)%data(en)%asMatrix(),transpose(math_inv33(phase_F(co,ce)))) ! ToDo: initial orientation correct? crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index 93c559ed5..6f865a16f 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -96,7 +96,7 @@ module subroutine damage_init() damage_active = .false. do ph = 1,phases%length - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) allocate(current(ph)%phi(Nmembers),source=1.0_pReal) @@ -137,8 +137,8 @@ module function phase_damage_constitutive(Delta_t,co,ce) result(converged_) ph, en - ph = material_phaseID(co,ce) - en = material_phaseEntry(co,ce) + ph = material_ID_phase(co,ce) + en = material_entry_phase(co,ce) converged_ = .not. integrateDamageState(Delta_t,ph,en) @@ -176,10 +176,10 @@ module subroutine damage_restore(ce) co - do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) - if (damageState(material_phaseID(co,ce))%sizeState > 0) & - damageState(material_phaseID(co,ce))%state( :,material_phaseEntry(co,ce)) = & - damageState(material_phaseID(co,ce))%state0(:,material_phaseEntry(co,ce)) + do co = 1,homogenization_Nconstituents(material_ID_homogenization(ce)) + if (damageState(material_ID_phase(co,ce))%sizeState > 0) & + damageState(material_ID_phase(co,ce))%state( :,material_entry_phase(co,ce)) = & + damageState(material_ID_phase(co,ce))%state0(:,material_entry_phase(co,ce)) end do end subroutine damage_restore @@ -200,8 +200,8 @@ module function phase_f_phi(phi,co,ce) result(f) ph, & en - ph = material_phaseID(co,ce) - en = material_phaseEntry(co,ce) + ph = material_ID_phase(co,ce) + en = material_entry_phase(co,ce) select case(phase_damage(ph)) case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID) @@ -400,7 +400,7 @@ module function phase_mu_phi(co,ce) result(mu) real(pReal) :: mu - mu = param(material_phaseID(co,ce))%mu + mu = param(material_ID_phase(co,ce))%mu end function phase_mu_phi @@ -414,7 +414,7 @@ module function phase_K_phi(co,ce) result(K) real(pReal), dimension(3,3) :: K - K = crystallite_push33ToRef(co,ce,param(material_phaseID(co,ce))%l_c**2*math_I3) + K = crystallite_push33ToRef(co,ce,param(material_ID_phase(co,ce))%l_c**2*math_I3) end function phase_K_phi @@ -498,7 +498,7 @@ module subroutine phase_set_phi(phi,co,ce) integer, intent(in) :: ce, co - current(material_phaseID(co,ce))%phi(material_phaseEntry(co,ce)) = phi + current(material_ID_phase(co,ce))%phi(material_entry_phase(co,ce)) = phi end subroutine phase_set_phi diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90 index 3c6880965..6988ac39a 100644 --- a/src/phase_damage_anisobrittle.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -89,7 +89,7 @@ module function anisobrittle_init() result(mySources) if (any(prm%g_crit < 0.0_pReal)) extmsg = trim(extmsg)//' g_crit' if (any(prm%s_crit < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit' - Nmembers = count(material_phaseID==ph) + Nmembers = count(material_ID_phase==ph) call phase_allocateState(damageState(ph),Nmembers,1,1,0) damageState(ph)%atol = src%get_asFloat('atol_phi',defaultVal=1.0e-9_pReal) if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi' diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 73fa3f762..f585fdd9d 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -73,7 +73,7 @@ module function isobrittle_init() result(mySources) ! sanity checks if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' - Nmembers = count(material_phaseID==ph) + Nmembers = count(material_ID_phase==ph) call phase_allocateState(damageState(ph),Nmembers,1,0,1) damageState(ph)%atol = src%get_asFloat('atol_phi',defaultVal=1.0e-9_pReal) if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi' diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index 50a423caa..5fc6cd064 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -237,7 +237,7 @@ module subroutine mechanical_init(phases) allocate(phase_mechanical_S0(phases%length)) do ph = 1, phases%length - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) allocate(phase_mechanical_Fe(ph)%data(3,3,Nmembers)) allocate(phase_mechanical_Fi(ph)%data(3,3,Nmembers)) @@ -260,11 +260,11 @@ module subroutine mechanical_init(phases) #endif end do - do ce = 1, size(material_phaseID,2) + do ce = 1, size(material_ID_phase,2) ma = discretization_materialAt((ce-1)/discretization_nIPs+1) - do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) - ph = material_phaseID(co,ce) - en = material_phaseEntry(co,ce) + do co = 1,homogenization_Nconstituents(material_ID_homogenization(ce)) + ph = material_ID_phase(co,ce) + en = material_entry_phase(co,ce) phase_mechanical_F(ph)%data(1:3,1:3,en) = math_I3 phase_mechanical_Fp(ph)%data(1:3,1:3,en) = material_O_0(ma)%data(co)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) phase_mechanical_Fe(ph)%data(1:3,1:3,en) = matmul(material_V_e_0(ma)%data(1:3,1:3,co), & @@ -1005,11 +1005,11 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_) subLi0, & subF0, & subF - real(pReal), dimension(plasticState(material_phaseID(co,ce))%sizeState) :: subState0 + real(pReal), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: subState0 - ph = material_phaseID(co,ce) - en = material_phaseEntry(co,ce) + ph = material_ID_phase(co,ce) + en = material_entry_phase(co,ce) subState0 = plasticState(ph)%state0(:,en) subLi0 = phase_mechanical_Li0(ph)%data(1:3,1:3,en) @@ -1082,9 +1082,9 @@ module subroutine mechanical_restore(ce,includeL) co, ph, en - do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) - ph = material_phaseID(co,ce) - en = material_phaseEntry(co,ce) + do co = 1,homogenization_Nconstituents(material_ID_homogenization(ce)) + ph = material_ID_phase(co,ce) + en = material_entry_phase(co,ce) if (includeL) then phase_mechanical_Lp(ph)%data(1:3,1:3,en) = phase_mechanical_Lp0(ph)%data(1:3,1:3,en) phase_mechanical_Li(ph)%data(1:3,1:3,en) = phase_mechanical_Li0(ph)%data(1:3,1:3,en) @@ -1133,8 +1133,8 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF) logical :: error - ph = material_phaseID(co,ce) - en = material_phaseEntry(co,ce) + ph = material_ID_phase(co,ce) + en = material_entry_phase(co,ce) call phase_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & phase_mechanical_Fe(ph)%data(1:3,1:3,en), & @@ -1328,7 +1328,7 @@ module function phase_P(co,ce) result(P) real(pReal), dimension(3,3) :: P - P = phase_mechanical_P(material_phaseID(co,ce))%data(1:3,1:3,material_phaseEntry(co,ce)) + P = phase_mechanical_P(material_ID_phase(co,ce))%data(1:3,1:3,material_entry_phase(co,ce)) end function phase_P @@ -1342,7 +1342,7 @@ module function phase_F(co,ce) result(F) real(pReal), dimension(3,3) :: F - F = phase_mechanical_F(material_phaseID(co,ce))%data(1:3,1:3,material_phaseEntry(co,ce)) + F = phase_mechanical_F(material_ID_phase(co,ce))%data(1:3,1:3,material_entry_phase(co,ce)) end function phase_F @@ -1356,7 +1356,7 @@ module subroutine phase_set_F(F,co,ce) integer, intent(in) :: co, ce - phase_mechanical_F(material_phaseID(co,ce))%data(1:3,1:3,material_phaseEntry(co,ce)) = F + phase_mechanical_F(material_ID_phase(co,ce))%data(1:3,1:3,material_entry_phase(co,ce)) = F end subroutine phase_set_F diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index 5ec974169..947816c5f 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -219,7 +219,7 @@ module function plastic_dislotungsten_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl sizeState = sizeDotState diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index aa17b497c..34a1b1d5d 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -380,7 +380,7 @@ module function plastic_dislotwin_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl & + size(['f_tw']) * prm%sum_N_tw & + size(['f_tr']) * prm%sum_N_tr diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index 53303df33..cbd0f82d3 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -118,7 +118,7 @@ module function plastic_isotropic_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) sizeDotState = size(['xi']) sizeState = sizeDotState diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index 6d3f5d029..1847a2722 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -173,7 +173,7 @@ module function plastic_kinehardening_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) sizeDotState = size(['xi ','chi ', 'gamma']) * prm%sum_N_sl sizeDeltaState = size(['sgn_gamma', 'chi_0 ', 'gamma_0 ']) * prm%sum_N_sl sizeState = sizeDotState + sizeDeltaState diff --git a/src/phase_mechanical_plastic_none.f90 b/src/phase_mechanical_plastic_none.f90 index 401b52102..351d4244b 100644 --- a/src/phase_mechanical_plastic_none.f90 +++ b/src/phase_mechanical_plastic_none.f90 @@ -31,7 +31,7 @@ module function plastic_none_init() result(myPlasticity) phases => config_material%get_dict('phase') do ph = 1, phases%length if (.not. myPlasticity(ph)) cycle - call phase_allocateState(plasticState(ph),count(material_phaseID == ph),0,0,0) + call phase_allocateState(plasticState(ph),count(material_ID_phase == ph),0,0,0) end do end function plastic_none_init diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 841e291e9..51e8af11a 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -394,7 +394,7 @@ module function plastic_nonlocal_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) sizeDotState = size([ 'rhoSglEdgePosMobile ','rhoSglEdgeNegMobile ', & 'rhoSglScrewPosMobile ','rhoSglScrewNegMobile ', & 'rhoSglEdgePosImmobile ','rhoSglEdgeNegImmobile ', & @@ -522,7 +522,7 @@ module function plastic_nonlocal_init() result(myPlasticity) if (.not. myPlasticity(ph)) cycle phase => phases%get_dict(ph) - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) l = 0 do t = 1,4 do s = 1,param(ph)%sum_N_sl @@ -662,8 +662,8 @@ module subroutine nonlocal_dependentState(ph, en) neighbor_ip = geom(ph)%IPneighborhood(2,n,en) if (neighbor_el > 0 .and. neighbor_ip > 0) then - if (material_phaseID(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) == ph) then - no = material_phaseEntry(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) + if (material_ID_phase(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) == ph) then + no = material_entry_phase(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) nRealNeighbors = nRealNeighbors + 1.0_pReal rho_neighbor0 = getRho0(ph,no) @@ -1251,8 +1251,8 @@ function rhoDotFlux(timestep,ph,en) neighbor_el = geom(ph)%IPneighborhood(1,n,en) neighbor_ip = geom(ph)%IPneighborhood(2,n,en) neighbor_n = geom(ph)%IPneighborhood(3,n,en) - np = material_phaseID(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) - no = material_phaseEntry(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) + np = material_ID_phase(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) + no = material_entry_phase(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) opposite_neighbor = n + mod(n,2) - mod(n+1,2) opposite_el = geom(ph)%IPneighborhood(1,opposite_neighbor,en) @@ -1399,7 +1399,7 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el) associate(prm => param(ph)) ns = prm%sum_N_sl - en = material_phaseEntry(1,(el-1)*discretization_nIPs + ip) + en = material_entry_phase(1,(el-1)*discretization_nIPs + ip) !*** start out fully compatible my_compatibility = 0.0_pReal forall(s1 = 1:ns) my_compatibility(:,s1,s1,:) = 1.0_pReal @@ -1407,8 +1407,8 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el) neighbors: do n = 1,nIPneighbors neighbor_e = IPneighborhood(1,n,ip,el) neighbor_i = IPneighborhood(2,n,ip,el) - neighbor_me = material_phaseEntry(1,(neighbor_e-1)*discretization_nIPs + neighbor_i) - neighbor_phase = material_phaseID(1,(neighbor_e-1)*discretization_nIPs + neighbor_i) + neighbor_me = material_entry_phase(1,(neighbor_e-1)*discretization_nIPs + neighbor_i) + neighbor_phase = material_ID_phase(1,(neighbor_e-1)*discretization_nIPs + neighbor_i) if (neighbor_e <= 0 .or. neighbor_i <= 0) then !* FREE SURFACE @@ -1467,7 +1467,7 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el) end do neighbors - dependentState(ph)%compatibility(:,:,:,:,material_phaseEntry(1,(el-1)*discretization_nIPs + ip)) = my_compatibility + dependentState(ph)%compatibility(:,:,:,:,material_entry_phase(1,(el-1)*discretization_nIPs + ip)) = my_compatibility end associate @@ -1772,14 +1772,14 @@ subroutine storeGeometry(ph) areaNormal = reshape(IPareaNormal,[3,nIPneighbors,nCell]) coords = reshape(discretization_IPcoords,[3,nCell]) - do ce = 1, size(material_homogenizationEntry,1) + do ce = 1, size(material_entry_homogenization,1) do co = 1, homogenization_maxNconstituents - if (material_phaseID(co,ce) == ph) then - geom(ph)%V_0(material_phaseEntry(co,ce)) = V(ce) - geom(ph)%IPneighborhood(:,:,material_phaseEntry(co,ce)) = neighborhood(:,:,ce) - geom(ph)%IParea(:,material_phaseEntry(co,ce)) = area(:,ce) - geom(ph)%IPareaNormal(:,:,material_phaseEntry(co,ce)) = areaNormal(:,:,ce) - geom(ph)%IPcoordinates(:,material_phaseEntry(co,ce)) = coords(:,ce) + if (material_ID_phase(co,ce) == ph) then + geom(ph)%V_0(material_entry_phase(co,ce)) = V(ce) + geom(ph)%IPneighborhood(:,:,material_entry_phase(co,ce)) = neighborhood(:,:,ce) + geom(ph)%IParea(:,material_entry_phase(co,ce)) = area(:,ce) + geom(ph)%IPareaNormal(:,:,material_entry_phase(co,ce)) = areaNormal(:,:,ce) + geom(ph)%IPcoordinates(:,material_entry_phase(co,ce)) = coords(:,ce) end if end do end do diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 047aeed4c..b558a8134 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -227,7 +227,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) sizeDotState = size(['xi_sl ','gamma_sl']) * prm%sum_N_sl & + size(['xi_tw ','gamma_tw']) * prm%sum_N_tw sizeState = sizeDotState diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 index 3f99c84f9..1e44258ef 100644 --- a/src/phase_thermal.f90 +++ b/src/phase_thermal.f90 @@ -99,7 +99,7 @@ module subroutine thermal_init(phases) allocate(param(phases%length)) do ph = 1, phases%length - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) allocate(current(ph)%T(Nmembers),source=T_ROOM) allocate(current(ph)%dot_T(Nmembers),source=0.0_pReal) phase => phases%get_dict(ph) @@ -212,8 +212,8 @@ module function phase_mu_T(co,ce) result(mu) real(pReal) :: mu - mu = phase_rho(material_phaseID(co,ce)) & - * param(material_phaseID(co,ce))%C_p + mu = phase_rho(material_ID_phase(co,ce)) & + * param(material_ID_phase(co,ce))%C_p end function phase_mu_T @@ -227,7 +227,7 @@ module function phase_K_T(co,ce) result(K) real(pReal), dimension(3,3) :: K - K = crystallite_push33ToRef(co,ce,param(material_phaseID(co,ce))%K) + K = crystallite_push33ToRef(co,ce,param(material_ID_phase(co,ce))%K) end function phase_K_T @@ -352,8 +352,8 @@ module subroutine phase_thermal_setField(T,dot_T, co,ce) integer, intent(in) :: ce, co - current(material_phaseID(co,ce))%T(material_phaseEntry(co,ce)) = T - current(material_phaseID(co,ce))%dot_T(material_phaseEntry(co,ce)) = dot_T + current(material_ID_phase(co,ce))%T(material_entry_phase(co,ce)) = T + current(material_ID_phase(co,ce))%dot_T(material_entry_phase(co,ce)) = dot_T end subroutine phase_thermal_setField diff --git a/src/phase_thermal_dissipation.f90 b/src/phase_thermal_dissipation.f90 index 711d278de..d36cc027b 100644 --- a/src/phase_thermal_dissipation.f90 +++ b/src/phase_thermal_dissipation.f90 @@ -57,7 +57,7 @@ module function dissipation_init(source_length) result(mySources) src => sources%get_dict(so) prm%kappa = src%get_asFloat('kappa') - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) call phase_allocateState(thermalState(ph)%p(so),Nmembers,0,0,0) end associate diff --git a/src/phase_thermal_externalheat.f90 b/src/phase_thermal_externalheat.f90 index 3dccc5791..0e1d11b62 100644 --- a/src/phase_thermal_externalheat.f90 +++ b/src/phase_thermal_externalheat.f90 @@ -63,7 +63,7 @@ module function externalheat_init(source_length) result(mySources) prm%f = table(src,'t','f') - Nmembers = count(material_phaseID == ph) + Nmembers = count(material_ID_phase == ph) call phase_allocateState(thermalState(ph)%p(so),Nmembers,1,1,0) end associate end if