diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index d8f4a0c3c..213b56a54 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -177,11 +177,6 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS if (iand(mode, CPFEM_AGERESULTS) /= 0_pInt) call CPFEM_forward - !chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP))) - ! case (THERMAL_conduction_ID) chosenThermal1 - ! temperature(material_homogenizationAt(elCP))%p(material_homogenizationMemberAt(ip,elCP)) = & - ! temperature_inp - !end select chosenThermal1 homogenization_F0(1:3,1:3,ce) = ffn homogenization_F(1:3,1:3,ce) = ffn1 diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 0d62f83c7..f25a749c2 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -245,11 +245,12 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE !$OMP PARALLEL !$OMP DO PRIVATE(ce,en,ho,myNgrains,NiterationMPstate,converged,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) - ho = material_homogenizationAt(el) - myNgrains = homogenization_Nconstituents(ho) + do ip = FEsolving_execIP(1),FEsolving_execIP(2) ce = (el-1)*discretization_nIPs + ip en = material_homogenizationEntry(ce) + ho = material_homogenizationID(ce) + myNgrains = homogenization_Nconstituents(ho) call phase_restore(ce,.false.) ! wrong name (is more a forward function) @@ -290,12 +291,12 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE !$OMP DO PRIVATE(ho,ph,ce) do el = FEsolving_execElem(1),FEsolving_execElem(2) if (terminallyIll) continue - ho = material_homogenizationAt(el) do ip = FEsolving_execIP(1),FEsolving_execIP(2) ce = (el-1)*discretization_nIPs + ip + ho = material_homogenizationID(ce) call thermal_partition(ce) do co = 1, homogenization_Nconstituents(ho) - ph = material_phaseAt(co,el) + ph = material_phaseID(co,ce) if (.not. thermal_stress(dt,ph,material_phaseMemberAt(co,ip,el))) then if (.not. terminallyIll) & ! so first signals terminally ill... print*, ' Integration point ', ip,' at element ', el, ' terminally ill' @@ -308,9 +309,9 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE !$OMP DO PRIVATE(ho,ce) elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) - ho = material_homogenizationAt(el) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) ce = (el-1)*discretization_nIPs + ip + ho = material_homogenizationID(ce) do co = 1, homogenization_Nconstituents(ho) call crystallite_orientations(co,ip,el) enddo diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index 0546834fd..b33616a7c 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -39,7 +39,7 @@ module subroutine damage_init() configHomogenization, & configHomogenizationDamage, & num_generic - integer :: ho,Nmaterialpoints + integer :: ho,Nmembers print'(/,a)', ' <<<+- homogenization:damage init -+>>>' @@ -50,7 +50,8 @@ module subroutine damage_init() allocate(current(configHomogenizations%length)) do ho = 1, configHomogenizations%length - allocate(current(ho)%phi(count(material_homogenizationID==ho)), source=1.0_pReal) + Nmembers = count(material_homogenizationID == ho) + allocate(current(ho)%phi(Nmembers), source=1.0_pReal) configHomogenization => configHomogenizations%get(ho) associate(prm => param(ho)) if (configHomogenization%contains('damage')) then @@ -60,10 +61,9 @@ module subroutine damage_init() #else prm%output = configHomogenizationDamage%get_as1dString('output',defaultVal=emptyStringArray) #endif - Nmaterialpoints = count(material_homogenizationAt == ho) damageState_h(ho)%sizeState = 1 - allocate(damageState_h(ho)%state0(1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState_h(ho)%state (1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState_h(ho)%state0(1,Nmembers), source=1.0_pReal) + allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pReal) else prm%output = emptyStringArray endif diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index 745c266d4..6392e00db 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -78,7 +78,7 @@ module subroutine RGC_init(num_homogMech) integer :: & ho, & - Nmaterialpoints, & + Nmembers, & sizeState, nIntFaceTot class (tNode), pointer :: & @@ -161,28 +161,28 @@ module subroutine RGC_init(num_homogMech) prm%D_alpha = homogMech%get_as1dFloat('D_alpha', requiredSize=3) prm%a_g = homogMech%get_as1dFloat('a_g', requiredSize=3) - Nmaterialpoints = count(material_homogenizationAt == ho) + Nmembers = count(material_homogenizationID == 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)) sizeState = nIntFaceTot homogState(ho)%sizeState = sizeState - allocate(homogState(ho)%state0 (sizeState,Nmaterialpoints), source=0.0_pReal) - allocate(homogState(ho)%state (sizeState,Nmaterialpoints), source=0.0_pReal) + allocate(homogState(ho)%state0 (sizeState,Nmembers), source=0.0_pReal) + allocate(homogState(ho)%state (sizeState,Nmembers), source=0.0_pReal) stt%relaxationVector => homogState(ho)%state(1:nIntFaceTot,:) st0%relaxationVector => homogState(ho)%state0(1:nIntFaceTot,:) - allocate(dst%volumeDiscrepancy( Nmaterialpoints), source=0.0_pReal) - allocate(dst%relaxationRate_avg( Nmaterialpoints), source=0.0_pReal) - allocate(dst%relaxationRate_max( Nmaterialpoints), source=0.0_pReal) - allocate(dst%mismatch( 3,Nmaterialpoints), source=0.0_pReal) + allocate(dst%volumeDiscrepancy( Nmembers), source=0.0_pReal) + allocate(dst%relaxationRate_avg( Nmembers), source=0.0_pReal) + allocate(dst%relaxationRate_max( Nmembers), source=0.0_pReal) + allocate(dst%mismatch( 3,Nmembers), source=0.0_pReal) !-------------------------------------------------------------------------------------------------- ! assigning cluster orientations - dependentState(ho)%orientation = spread(eu2om(prm%a_g*inRad),3,Nmaterialpoints) - !dst%orientation = spread(eu2om(prm%a_g*inRad),3,Nmaterialpoints) ifort version 18.0.1 crashes (for whatever reason) + dependentState(ho)%orientation = spread(eu2om(prm%a_g*inRad),3,Nmembers) + !dst%orientation = spread(eu2om(prm%a_g*inRad),3,Nmembers) ifort version 18.0.1 crashes (for whatever reason) end associate diff --git a/src/homogenization_mechanical_isostrain.f90 b/src/homogenization_mechanical_isostrain.f90 index 7b114d04f..1dfac425c 100644 --- a/src/homogenization_mechanical_isostrain.f90 +++ b/src/homogenization_mechanical_isostrain.f90 @@ -15,7 +15,7 @@ module subroutine isostrain_init integer :: & ho, & - Nmaterialpoints + Nmembers print'(/,a)', ' <<<+- homogenization:mechanical:isostrain init -+>>>' @@ -25,10 +25,10 @@ module subroutine isostrain_init do ho = 1, size(homogenization_type) if (homogenization_type(ho) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle - Nmaterialpoints = count(material_homogenizationAt == ho) + Nmembers = count(material_homogenizationID == ho) homogState(ho)%sizeState = 0 - allocate(homogState(ho)%state0(0,Nmaterialpoints)) - allocate(homogState(ho)%state (0,Nmaterialpoints)) + allocate(homogState(ho)%state0(0,Nmembers)) + allocate(homogState(ho)%state (0,Nmembers)) enddo diff --git a/src/homogenization_mechanical_pass.f90 b/src/homogenization_mechanical_pass.f90 index e2e44658a..0728d8a06 100644 --- a/src/homogenization_mechanical_pass.f90 +++ b/src/homogenization_mechanical_pass.f90 @@ -15,7 +15,7 @@ module subroutine pass_init integer :: & ho, & - Nmaterialpoints + Nmembers print'(/,a)', ' <<<+- homogenization:mechanical:pass init -+>>>' @@ -28,10 +28,10 @@ module subroutine pass_init if(homogenization_Nconstituents(ho) /= 1) & call IO_error(211,ext_msg='N_constituents (pass)') - Nmaterialpoints = count(material_homogenizationAt == ho) + Nmembers = count(material_homogenizationID == ho) homogState(ho)%sizeState = 0 - allocate(homogState(ho)%state0(0,Nmaterialpoints)) - allocate(homogState(ho)%state (0,Nmaterialpoints)) + allocate(homogState(ho)%state0(0,Nmembers)) + allocate(homogState(ho)%state (0,Nmembers)) enddo diff --git a/src/material.f90 b/src/material.f90 index 9d67fc34c..7aee676e6 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -32,7 +32,6 @@ module material material_name_homogenization !< name of each homogenization integer, dimension(:), allocatable, public, protected :: & ! (elem) - material_homogenizationAt, & !< homogenization ID of each element TODO: remove material_homogenizationID, & !< per cell TODO: material_ID_homogenization material_homogenizationEntry !< per cell TODO: material_entry_homogenization integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem) @@ -40,7 +39,7 @@ module material material_phaseID, & !< per (constituent,cell) TODO: material_ID_phase material_phaseEntry !< per (constituent,cell) TODO: material_entry_phase integer, dimension(:,:,:), allocatable, public, protected :: & ! (constituent,IP,elem) - material_phaseMemberAt !TODO: remove + material_phaseMemberAt !TODO: remove public :: & tRotationContainer, & material_orientation0, & @@ -114,7 +113,6 @@ subroutine parse() allocate(counterPhase(phases%length),source=0) allocate(counterHomogenization(homogenizations%length),source=0) - allocate(material_homogenizationAt(discretization_Nelems),source=0) allocate(material_phaseAt(homogenization_maxNconstituents,discretization_Nelems),source=0) allocate(material_phaseMemberAt(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems),source=0) @@ -128,12 +126,11 @@ subroutine parse() material => materials%get(discretization_materialAt(el)) constituents => material%get('constituents') - material_homogenizationAt(el) = homogenizations%getIndex(material%get_asString('homogenization')) do ip = 1, discretization_nIPs ce = (el-1)*discretization_nIPs + ip - counterHomogenization(material_homogenizationAt(el)) = counterHomogenization(material_homogenizationAt(el)) + 1 - material_homogenizationEntry(ce) = counterHomogenization(material_homogenizationAt(el)) - material_homogenizationID(ce) = material_homogenizationAt(el) + material_homogenizationID(ce) = homogenizations%getIndex(material%get_asString('homogenization')) + counterHomogenization(material_homogenizationID(ce)) = counterHomogenization(material_homogenizationID(ce)) + 1 + material_homogenizationEntry(ce) = counterHomogenization(material_homogenizationID(ce)) enddo frac = 0.0_pReal diff --git a/src/phase.f90 b/src/phase.f90 index e2cb87332..a72d72d1a 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -501,6 +501,7 @@ subroutine crystallite_init() integer :: & ph, & + ce, & co, & !< counter in integration point component loop ip, & !< counter in integration point loop el, & !< counter in element loop @@ -566,7 +567,8 @@ subroutine crystallite_init() !$OMP PARALLEL DO do el = 1, eMax do ip = 1, iMax - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ce = (el-1)*discretization_nIPs + ip + do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) call crystallite_orientations(co,ip,el) call plastic_dependentState(co,ip,el) ! update dependent state variables to be consistent with basic states enddo diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index ed3a737b1..8d07b73df 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -1020,8 +1020,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), dimension(:), allocatable :: subState0 - ph = material_phaseAt(co,el) - en = material_phaseMemberAt(co,ip,el) + ph = material_phaseID(co,(el-1)*discretization_nIPs + ip) + en = material_phaseEntry(co,(el-1)*discretization_nIPs + ip) sizeDotState = plasticState(ph)%sizeDotState subLi0 = phase_mechanical_Li0(ph)%data(1:3,1:3,en) diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 0eccf767e..bde14756e 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -506,7 +506,6 @@ module function plastic_nonlocal_init() result(myPlasticity) end associate if (Nmembers > 0) call stateInit(ini,ph,Nmembers) - plasticState(ph)%state0 = plasticState(ph)%state !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range