diff --git a/code/config/material.config b/code/config/material.config index 59c390874..c80bc6277 100644 --- a/code/config/material.config +++ b/code/config/material.config @@ -90,7 +90,7 @@ crystallite 2 [Aluminum_J2isotropic] -constitution j2 +plasticity j2 (output) flowstress (output) strainrate @@ -108,7 +108,7 @@ atol_resistance 1 [Aluminum_phenopowerlaw] # slip only -constitution phenopowerlaw +plasticity phenopowerlaw (output) resistance_slip (output) shearrate_slip @@ -152,7 +152,7 @@ atol_resistance 1 [Aluminum_nonlocal] -constitution nonlocal +plasticity nonlocal /nonlocal/ (output) rho @@ -265,7 +265,7 @@ interaction_SlipSlip 0.122 0.122 0.625 0.07 0.137 0.122 # Dislocation i [BCC_Ferrite] -constitution phenopowerlaw +plasticity phenopowerlaw lattice_structure bcc Nslip 12 0 0 0 # per family Ntwin 0 0 0 0 # per family @@ -296,7 +296,7 @@ a_slip 1.0 atol_resistance 1 [BCC_Martensite] -constitution phenopowerlaw +plasticity phenopowerlaw lattice_structure bcc Nslip 12 0 0 0 # per family Ntwin 0 0 0 0 # per family @@ -329,7 +329,7 @@ atol_resistance 1 [TWIP steel FeMnC] -constitution dislotwin +plasticity dislotwin #(output) edge_density #(output) dipole_density diff --git a/code/constitutive.f90 b/code/constitutive.f90 index c570b3342..7ce6e6025 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -91,8 +91,8 @@ subroutine constitutive_init material_localFileExt, & material_configFile, & phase_name, & - phase_constitution, & - phase_constitutionInstance, & + phase_plasticity, & + phase_plasticityInstance, & phase_Noutput, & homogenization_Ngrains, & homogenization_maxNgrains @@ -136,9 +136,9 @@ close(fileunit) call IO_write_jobFile(fileunit,'outputConstitutive') do p = 1_pInt,material_Nphase - i = phase_constitutionInstance(p) ! which instance of a constitution is present phase + i = phase_plasticityInstance(p) ! which instance of a constitution is present phase knownConstitution = .true. ! assume valid - select case(phase_constitution(p)) ! split per constitiution + select case(phase_plasticity(p)) ! split per constitiution case (constitutive_j2_label) thisOutput => constitutive_j2_output thisSize => constitutive_j2_sizePostResult @@ -161,7 +161,7 @@ do p = 1_pInt,material_Nphase write(fileunit,'(a)') '['//trim(phase_name(p))//']' write(fileunit,*) if (knownConstitution) then - write(fileunit,'(a)') '(constitution)'//char(9)//trim(phase_constitution(p)) + write(fileunit,'(a)') '(constitution)'//char(9)//trim(phase_plasticity(p)) do e = 1_pInt,phase_Noutput(p) write(fileunit,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) enddo @@ -203,8 +203,8 @@ endif myNgrains = homogenization_Ngrains(mesh_element(3,e)) do i = 1_pInt,FE_Nips(mesh_element(2,e)) ! loop over IPs do g = 1_pInt,myNgrains ! loop over grains - myInstance = phase_constitutionInstance(material_phase(g,i,e)) - select case(phase_constitution(material_phase(g,i,e))) + myInstance = phase_plasticityInstance(material_phase(g,i,e)) + select case(phase_plasticity(material_phase(g,i,e))) case (constitutive_j2_label) allocate(constitutive_state0(g,i,e)%p(constitutive_j2_sizeState(myInstance))) @@ -392,7 +392,7 @@ function constitutive_homogenizedC(ipc,ip,el) !* - el : current element * !********************************************************************* use prec, only: pReal - use material, only: phase_constitution,material_phase + use material, only: phase_plasticity,material_phase use constitutive_j2 use constitutive_phenopowerlaw use constitutive_titanmod @@ -403,7 +403,7 @@ function constitutive_homogenizedC(ipc,ip,el) integer(pInt) :: ipc,ip,el real(pReal), dimension(6,6) :: constitutive_homogenizedC - select case (phase_constitution(material_phase(ipc,ip,el))) + select case (phase_plasticity(material_phase(ipc,ip,el))) case (constitutive_j2_label) constitutive_homogenizedC = constitutive_j2_homogenizedC(constitutive_state,ipc,ip,el) @@ -435,7 +435,7 @@ function constitutive_averageBurgers(ipc,ip,el) !* - el : current element * !********************************************************************* use prec, only: pReal - use material, only: phase_constitution,material_phase + use material, only: phase_plasticity,material_phase use constitutive_j2 use constitutive_phenopowerlaw use constitutive_titanmod @@ -446,7 +446,7 @@ function constitutive_averageBurgers(ipc,ip,el) integer(pInt) :: ipc,ip,el real(pReal) :: constitutive_averageBurgers - select case (phase_constitution(material_phase(ipc,ip,el))) + select case (phase_plasticity(material_phase(ipc,ip,el))) case (constitutive_j2_label) constitutive_averageBurgers = 2.5e-10_pReal !constitutive_j2_averageBurgers(constitutive_state,ipc,ip,el) @@ -475,7 +475,7 @@ endfunction !********************************************************************* subroutine constitutive_microstructure(Temperature, Fe, Fp, ipc, ip, el) use prec, only: pReal -use material, only: phase_constitution, & +use material, only: phase_plasticity, & material_phase use constitutive_j2, only: constitutive_j2_label, & constitutive_j2_microstructure @@ -502,7 +502,7 @@ real(pReal), dimension(3,3), intent(in) :: Fe, & ! elastic deformation gr !*** local variables ***! -select case (phase_constitution(material_phase(ipc,ip,el))) +select case (phase_plasticity(material_phase(ipc,ip,el))) case (constitutive_j2_label) call constitutive_j2_microstructure(Temperature,constitutive_state,ipc,ip,el) @@ -532,7 +532,7 @@ endsubroutine subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, Temperature, ipc, ip, el) use prec, only: pReal -use material, only: phase_constitution, & +use material, only: phase_plasticity, & material_phase use constitutive_j2, only: constitutive_j2_label, & constitutive_j2_LpAndItsTangent @@ -561,7 +561,7 @@ real(pReal), dimension(9,9), intent(out) :: dLp_dTstar ! derivative of Lp wit !*** local variables ***! -select case (phase_constitution(material_phase(ipc,ip,el))) +select case (phase_plasticity(material_phase(ipc,ip,el))) case (constitutive_j2_label) call constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state,ipc,ip,el) @@ -598,7 +598,7 @@ use debug, only: debug_cumDotStateCalls, & debug_levelBasic use mesh, only: mesh_NcpElems, & mesh_maxNips -use material, only: phase_constitution, & +use material, only: phase_plasticity, & material_phase, & homogenization_maxNgrains use constitutive_j2, only: constitutive_j2_dotState, & @@ -635,7 +635,7 @@ if (iand(debug_what(debug_constitutive), debug_levelBasic) /= 0_pInt) then call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) endif -select case (phase_constitution(material_phase(ipc,ip,el))) +select case (phase_plasticity(material_phase(ipc,ip,el))) case (constitutive_j2_label) constitutive_dotState(ipc,ip,el)%p = constitutive_j2_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el) @@ -681,7 +681,7 @@ use debug, only: debug_cumDotTemperatureCalls, & debug_what, & debug_constitutive, & debug_levelBasic -use material, only: phase_constitution, & +use material, only: phase_plasticity, & material_phase use constitutive_j2, only: constitutive_j2_dotTemperature, & constitutive_j2_label @@ -716,7 +716,7 @@ if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) endif -select case (phase_constitution(material_phase(ipc,ip,el))) +select case (phase_plasticity(material_phase(ipc,ip,el))) case (constitutive_j2_label) constitutive_dotTemperature = constitutive_j2_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el) @@ -762,7 +762,7 @@ function constitutive_postResults(Tstar_v, Fe, Temperature, dt, ipc, ip, el) use prec, only: pReal use mesh, only: mesh_NcpElems, & mesh_maxNips -use material, only: phase_constitution, & +use material, only: phase_plasticity, & material_phase, & homogenization_maxNgrains use constitutive_j2, only: constitutive_j2_postResults, & @@ -795,7 +795,7 @@ real(pReal), dimension(constitutive_sizePostResults(ipc,ip,el)) :: constitutive_ constitutive_postResults = 0.0_pReal -select case (phase_constitution(material_phase(ipc,ip,el))) +select case (phase_plasticity(material_phase(ipc,ip,el))) case (constitutive_j2_label) constitutive_postResults = constitutive_j2_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el) diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index b011f0855..fe848abc9 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -158,7 +158,7 @@ character(len=1024) line #include "compilation_info.f90" !$OMP END CRITICAL (write2out) -maxNinstance = int(count(phase_constitution == constitutive_dislotwin_label),pInt) +maxNinstance = int(count(phase_plasticity == constitutive_dislotwin_label),pInt) if (maxNinstance == 0_pInt) return !* Space allocation for global variables @@ -295,8 +295,8 @@ do ! read thru sections of section = section + 1_pInt ! advance section counter cycle endif - if (section > 0_pInt .and. phase_constitution(section) == constitutive_dislotwin_label) then ! one of my sections - i = phase_constitutionInstance(section) ! which instance of my constitution is present phase + if (section > 0_pInt .and. phase_plasticity(section) == constitutive_dislotwin_label) then ! one of my sections + i = phase_plasticityInstance(section) ! which instance of my constitution is present phase positions = IO_stringPos(line,maxNchunks) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) @@ -766,7 +766,7 @@ pure function constitutive_dislotwin_homogenizedC(state,g,ip,el) !********************************************************************* use prec, only: pReal,pInt,p_vec use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance implicit none !* Input-Output variables @@ -778,7 +778,7 @@ integer(pInt) myInstance,ns,nt,i real(pReal) sumf !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) ns = constitutive_dislotwin_totalNslip(myInstance) nt = constitutive_dislotwin_totalNtwin(myInstance) @@ -808,7 +808,7 @@ subroutine constitutive_dislotwin_microstructure(Temperature,state,g,ip,el) use prec, only: pReal,pInt,p_vec use math, only: pi use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance !use debug, only: debugger implicit none @@ -819,10 +819,10 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in !* Local variables integer(pInt) myInstance,myStructure,ns,nt,s,t real(pReal) sumf,sfe -real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: fOverStacksize +real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: fOverStacksize !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_dislotwin_structure(myInstance) ns = constitutive_dislotwin_totalNslip(myInstance) nt = constitutive_dislotwin_totalNtwin(myInstance) @@ -942,7 +942,7 @@ use prec, only: pReal,pInt,p_vec use math, only: math_Plain3333to99, math_Mandel6to33, math_Mandel33to6, & math_spectralDecompositionSym33, math_tensorproduct, math_symmetric33,math_mul33x3 use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance use lattice, only: lattice_Sslip,lattice_Sslip_v,lattice_Stwin,lattice_Stwin_v,lattice_maxNslipFamily,lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem,lattice_shearTwin implicit none @@ -958,9 +958,9 @@ real(pReal), dimension(9,9), intent(out) :: dLp_dTstar integer(pInt) myInstance,myStructure,ns,nt,f,i,j,k,l,m,n,index_myFamily real(pReal) sumf,StressRatio_p,StressRatio_pminus1,StressRatio_r,BoltzmannRatio,DotGamma0 real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 -real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & gdot_slip,dgdot_dtauslip,tau_slip -real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: & gdot_twin,dgdot_dtautwin,tau_twin real(pReal), dimension(6) :: gdot_sb,dgdot_dtausb,tau_sb real(pReal), dimension(3,3) :: eigVectors, sb_Smatrix @@ -987,7 +987,7 @@ real(pReal), dimension(3,6), parameter :: & logical error !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_dislotwin_structure(myInstance) ns = constitutive_dislotwin_totalNslip(myInstance) nt = constitutive_dislotwin_totalNtwin(myInstance) @@ -1163,7 +1163,7 @@ use prec, only: pReal,pInt,p_vec use math, only: pi use mesh, only: mesh_NcpElems, mesh_maxNips -use material, only: homogenization_maxNgrains, material_phase, phase_constitutionInstance +use material, only: homogenization_maxNgrains, material_phase, phase_plasticityInstance use lattice, only: lattice_Sslip_v, lattice_Stwin_v, & lattice_maxNslipFamily,lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem @@ -1174,21 +1174,21 @@ integer(pInt), intent(in) :: g,ip,el real(pReal), intent(in) :: Temperature real(pReal), dimension(6), intent(in) :: Tstar_v type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state -real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(g,ip,el)))) :: & constitutive_dislotwin_dotState !* Local variables integer(pInt) MyInstance,MyStructure,ns,nt,f,i,j,index_myFamily real(pReal) sumf,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,& EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,StressRatio_r -real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & gdot_slip,tau_slip,DotRhoMultiplication,EdgeDipDistance,DotRhoEdgeEdgeAnnihilation,DotRhoEdgeDipAnnihilation,& ClimbVelocity,DotRhoEdgeDipClimb,DotRhoDipFormation -real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: & tau_twin !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) MyStructure = constitutive_dislotwin_structure(myInstance) ns = constitutive_dislotwin_totalNslip(myInstance) nt = constitutive_dislotwin_totalNtwin(myInstance) @@ -1363,7 +1363,7 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,dt,state,g,ip,el use prec, only: pReal,pInt,p_vec use math, only: pi,math_Mandel6to33, math_spectralDecompositionSym33 use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance,phase_Noutput +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance,phase_Noutput use lattice, only: lattice_Sslip_v,lattice_Stwin_v,lattice_maxNslipFamily,lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem implicit none @@ -1378,11 +1378,11 @@ real(pReal) sumf,tau,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0, real(pReal), dimension(3,3) :: eigVectors real(pReal), dimension (3) :: eigValues logical error -real(pReal), dimension(constitutive_dislotwin_sizePostResults(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_dislotwin_sizePostResults(phase_plasticityInstance(material_phase(g,ip,el)))) :: & constitutive_dislotwin_postResults !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_dislotwin_structure(myInstance) ns = constitutive_dislotwin_totalNslip(myInstance) nt = constitutive_dislotwin_totalNtwin(myInstance) diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index fc770b43d..e0742ce79 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -121,7 +121,7 @@ subroutine constitutive_j2_init(myFile) #include "compilation_info.f90" !$OMP END CRITICAL (write2out) - maxNinstance = int(count(phase_constitution == constitutive_j2_label),pInt) + maxNinstance = int(count(phase_plasticity == constitutive_j2_label),pInt) if (maxNinstance == 0_pInt) return if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then @@ -180,8 +180,8 @@ subroutine constitutive_j2_init(myFile) section = section + 1_pInt ! advance section counter cycle endif - if (section > 0_pInt .and. phase_constitution(section) == constitutive_j2_label) then ! one of my sections - i = phase_constitutionInstance(section) ! which instance of my constitution is present phase + if (section > 0_pInt .and. phase_plasticity(section) == constitutive_j2_label) then ! one of my sections + i = phase_plasticityInstance(section) ! which instance of my constitution is present phase positions = IO_stringPos(line,maxNchunks) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) @@ -305,7 +305,7 @@ function constitutive_j2_homogenizedC(state,ipc,ip,el) !********************************************************************* use prec, only: p_vec use mesh, only: mesh_NcpElems,mesh_maxNips - use material, only: homogenization_maxNgrains,material_phase, phase_constitutionInstance + use material, only: homogenization_maxNgrains,material_phase, phase_plasticityInstance implicit none integer(pInt), intent(in) :: ipc,ip,el @@ -313,7 +313,7 @@ function constitutive_j2_homogenizedC(state,ipc,ip,el) real(pReal), dimension(6,6) :: constitutive_j2_homogenizedC type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: state - matID = phase_constitutionInstance(material_phase(ipc,ip,el)) + matID = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_j2_homogenizedC = constitutive_j2_Cslip_66(1:6,1:6,matID) end function constitutive_j2_homogenizedC @@ -330,7 +330,7 @@ subroutine constitutive_j2_microstructure(Temperature,state,ipc,ip,el) !********************************************************************* use prec, only: p_vec use mesh, only: mesh_NcpElems,mesh_maxNips - use material, only: homogenization_maxNgrains,material_phase, phase_constitutionInstance + use material, only: homogenization_maxNgrains,material_phase, phase_plasticityInstance implicit none !* Definition of variables @@ -338,7 +338,7 @@ subroutine constitutive_j2_microstructure(Temperature,state,ipc,ip,el) real(pReal) Temperature type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: state - matID = phase_constitutionInstance(material_phase(ipc,ip,el)) + matID = phase_plasticityInstance(material_phase(ipc,ip,el)) end subroutine constitutive_j2_microstructure @@ -357,7 +357,7 @@ pure subroutine constitutive_j2_LpAndItsTangent(Lp, dLp_dTstar_99, Tstar_dev_v, mesh_maxNips use material, only: homogenization_maxNgrains, & material_phase, & - phase_constitutionInstance + phase_plasticityInstance implicit none !*** input variables ***! @@ -384,7 +384,7 @@ pure subroutine constitutive_j2_LpAndItsTangent(Lp, dLp_dTstar_99, Tstar_dev_v, m, & n - matID = phase_constitutionInstance(material_phase(g,ip,el)) + matID = phase_plasticityInstance(material_phase(g,ip,el)) ! convert Tstar to matrix and calculate euclidean norm Tstar_dev_33 = math_Mandel6to33(Tstar_dev_v) @@ -429,7 +429,7 @@ pure function constitutive_j2_dotState(Tstar_v, Temperature, state, g, ip, el) mesh_maxNips use material, only: homogenization_maxNgrains, & material_phase, & - phase_constitutionInstance + phase_plasticityInstance implicit none !*** input variables ***! @@ -450,7 +450,7 @@ pure function constitutive_j2_dotState(Tstar_v, Temperature, state, g, ip, el) norm_Tstar_dev ! euclidean norm of Tstar_dev integer(pInt) matID - matID = phase_constitutionInstance(material_phase(g,ip,el)) + matID = phase_plasticityInstance(material_phase(g,ip,el)) ! deviatoric part of 2nd Piola-Kirchhoff stress Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal @@ -513,7 +513,7 @@ pure function constitutive_j2_postResults(Tstar_v, Temperature, dt, state, g, ip mesh_maxNips use material, only: homogenization_maxNgrains, & material_phase, & - phase_constitutionInstance, & + phase_plasticityInstance, & phase_Noutput implicit none @@ -527,7 +527,7 @@ pure function constitutive_j2_postResults(Tstar_v, Temperature, dt, state, g, ip type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state ! state of the current microstructure !*** output variables ***! - real(pReal), dimension(constitutive_j2_sizePostResults(phase_constitutionInstance(material_phase(g,ip,el)))) :: & + real(pReal), dimension(constitutive_j2_sizePostResults(phase_plasticityInstance(material_phase(g,ip,el)))) :: & constitutive_j2_postResults !*** local variables ***! @@ -543,7 +543,7 @@ pure function constitutive_j2_postResults(Tstar_v, Temperature, dt, state, g, ip ! constitutive_j2_n - matID = phase_constitutionInstance(material_phase(g,ip,el)) + matID = phase_plasticityInstance(material_phase(g,ip,el)) ! calculate deviatoric part of 2nd Piola-Kirchhoff stress and its norm Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 442210abe..e33805f07 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -62,7 +62,7 @@ integer(pInt), dimension(:), allocatable :: constitutive_nonlocal_ constitutive_nonlocal_sizePostResults ! cumulative size of post results integer(pInt), dimension(:,:), allocatable, target :: constitutive_nonlocal_sizePostResult ! size of each post result output character(len=64), dimension(:,:), allocatable, target :: constitutive_nonlocal_output ! name of each post result output -integer(pInt), dimension(:), allocatable :: constitutive_nonlocal_Noutput ! number of outputs per instance of this constitution +integer(pInt), dimension(:), allocatable :: constitutive_nonlocal_Noutput ! number of outputs per instance of this plasticity character(len=32), dimension(:), allocatable :: constitutive_nonlocal_structureName ! name of the lattice structure integer(pInt), dimension(:), allocatable :: constitutive_nonlocal_structure, & ! number representing the kind of lattice structure @@ -162,8 +162,8 @@ use mesh, only: mesh_NcpElems, & mesh_maxNips, & FE_maxNipNeighbors use material, only: homogenization_maxNgrains, & - phase_constitution, & - phase_constitutionInstance, & + phase_plasticity, & + phase_plasticityInstance, & phase_Noutput use lattice, only: lattice_maxNslipFamily, & lattice_maxNslip, & @@ -189,7 +189,7 @@ integer(pInt) section, & maxTotalNslip, & myStructure, & f, & ! index of my slip family - i, & ! index of my instance of this constitution + i, & ! index of my instance of this plasticity j, & k, & l, & @@ -211,7 +211,7 @@ character(len=1024) line #include "compilation_info.f90" !$OMP END CRITICAL (write2out) -maxNinstance = int(count(phase_constitution == constitutive_nonlocal_label),pInt) +maxNinstance = int(count(phase_plasticity == constitutive_nonlocal_label),pInt) if (maxNinstance == 0) return ! we don't have to do anything if there's no instance for this constitutive law if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then @@ -344,12 +344,12 @@ do section = section + 1_pInt ! advance section counter cycle endif - if (section > 0_pInt .and. phase_constitution(section) == constitutive_nonlocal_label) then ! one of my sections - i = phase_constitutionInstance(section) ! which instance of my constitution is present phase + if (section > 0_pInt .and. phase_plasticity(section) == constitutive_nonlocal_label) then ! one of my sections + i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase positions = IO_stringPos(line,maxNchunks) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) - case('constitution','/nonlocal/') + case('plasticity','/nonlocal/') cycle case ('(output)') constitutive_nonlocal_Noutput(i) = constitutive_nonlocal_Noutput(i) + 1_pInt @@ -750,7 +750,7 @@ use math, only: math_sampleGaussVar implicit none !*** input variables -integer(pInt), intent(in) :: myInstance ! number specifying the current instance of the constitution +integer(pInt), intent(in) :: myInstance ! number specifying the current instance of the plasticity !*** output variables real(pReal), dimension(constitutive_nonlocal_sizeState(myInstance)) :: & @@ -829,11 +829,11 @@ use prec, only: pReal, & implicit none !*** input variables -integer(pInt), intent(in) :: myInstance ! number specifying the current instance of the constitution +integer(pInt), intent(in) :: myInstance ! number specifying the current instance of the plasticity !*** output variables real(pReal), dimension(constitutive_nonlocal_sizeState(myInstance)) :: & - constitutive_nonlocal_aTolState ! absolute state tolerance for the current instance of this constitution + constitutive_nonlocal_aTolState ! absolute state tolerance for the current instance of this plasticity !*** local variables @@ -855,7 +855,7 @@ use mesh, only: mesh_NcpElems, & mesh_maxNips use material, only: homogenization_maxNgrains, & material_phase, & - phase_constitutionInstance + phase_plasticityInstance implicit none !*** input variables @@ -868,9 +868,9 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in real(pReal), dimension(6,6) :: constitutive_nonlocal_homogenizedC ! homogenized elasticity matrix !*** local variables -integer(pInt) myInstance ! current instance of this constitution +integer(pInt) myInstance ! current instance of this plasticity -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) constitutive_nonlocal_homogenizedC = constitutive_nonlocal_Cslip_66(1:6,1:6,myInstance) @@ -914,8 +914,8 @@ use mesh, only: mesh_NcpElems, & mesh_ipAreaNormal use material, only: homogenization_maxNgrains, & material_phase, & - phase_localConstitution, & - phase_constitutionInstance + phase_localPlasticity, & + phase_plasticityInstance use lattice, only: lattice_sd, & lattice_st @@ -939,8 +939,8 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in !*** local variables integer(pInt) neighboring_el, & ! element number of neighboring material point neighboring_ip, & ! integration point of neighboring material point - instance, & ! my instance of this constitution - neighboring_instance, & ! instance of this constitution of neighboring material point + instance, & ! my instance of this plasticity + neighboring_instance, & ! instance of this plasticity of neighboring material point latticeStruct, & ! my lattice structure neighboring_latticeStruct, & ! lattice structure of neighboring material point phase, & @@ -973,7 +973,7 @@ real(pReal), dimension(3) :: ipCoords, & neighboring_ipCoords real(pReal), dimension(FE_maxNipNeighbors) :: & distance ! length of connection vector -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & rhoForest, & ! forest dislocation density tauBack, & ! back stress from pileup on same slip system tauThreshold ! threshold shear stress @@ -984,22 +984,22 @@ real(pReal), dimension(3,3) :: invFe, & ! inverse of elast real(pReal), dimension(3,FE_maxNipNeighbors) :: & connection_latticeConf, & areaNormal_latticeConf -real(pReal), dimension(2,constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(2,constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & rhoExcess -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),2) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),2) :: & rhoDip ! dipole dislocation density (edge, screw) -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),8) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),8) :: & rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) real(pReal), dimension(3,3,2) :: connections real(pReal), dimension(2,maxval(constitutive_nonlocal_totalNslip),FE_maxNipNeighbors) :: & neighboring_rhoExcess ! excess density at neighboring material point -real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),2) :: & +real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),2) :: & m ! direction of dislocation motion logical inversionError phase = material_phase(g,ip,el) -instance = phase_constitutionInstance(phase) +instance = phase_plasticityInstance(phase) latticeStruct = constitutive_nonlocal_structure(instance) ns = constitutive_nonlocal_totalNslip(instance) @@ -1037,11 +1037,11 @@ forall (s = 1_pInt:ns) end forall !*** calculate the dislocation stress of the neighboring excess dislocation densities -!*** zero for material points of local constitution +!*** zero for material points of local plasticity tauBack = 0.0_pReal -if (.not. phase_localConstitution(phase)) then +if (.not. phase_localPlasticity(phase)) then call math_invert33(Fe, invFe, detFe, inversionError) call math_invert33(Fp, invFp, detFp, inversionError) ipCoords = mesh_ipCenterOfGravity(1:3,ip,el) @@ -1060,11 +1060,11 @@ if (.not. phase_localConstitution(phase)) then areaNormal_latticeConf(1:3,n) = areaNormal_latticeConf(1:3,n) / math_norm3(areaNormal_latticeConf(1:3,n)) ! normalize the surface normal to unit length if (neighboring_el > 0 .and. neighboring_ip > 0) then neighboring_phase = material_phase(g,neighboring_ip,neighboring_el) - neighboring_instance = phase_constitutionInstance(neighboring_phase) + neighboring_instance = phase_plasticityInstance(neighboring_phase) neighboring_latticeStruct = constitutive_nonlocal_structure(neighboring_instance) neighboring_ns = constitutive_nonlocal_totalNslip(neighboring_instance) neighboring_ipCoords = mesh_ipCenterOfGravity(1:3,neighboring_ip,neighboring_el) - if (.not. phase_localConstitution(neighboring_phase) & + if (.not. phase_localPlasticity(neighboring_phase) & .and. neighboring_latticeStruct == latticeStruct & .and. neighboring_instance == instance) then if (neighboring_ns == ns) then @@ -1083,7 +1083,7 @@ if (.not. phase_localConstitution(phase)) then call IO_error(-1_pInt,ext_msg='different number of active slip systems in neighboring IPs of same crystal structure') endif else - ! local neighbor or different lattice structure or different constitution instance + ! local neighbor or different lattice structure or different plasticity instance connection_latticeConf(1:3,n) = math_mul33x3(invFe, neighboring_ipCoords - ipCoords) neighboring_rhoExcess(1:2,1:ns,n) = rhoExcess endif @@ -1225,7 +1225,7 @@ use debug, only: debug_what, & debug_i, & debug_e use material, only: material_phase, & - phase_constitutionInstance + phase_plasticityInstance implicit none @@ -1235,23 +1235,23 @@ integer(pInt), intent(in) :: g, & ! curren el, & ! current element number c ! dislocation character (1:edge, 2:screw) real(pReal), intent(in) :: Temperature ! temperature -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))), & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))), & intent(in) :: tau ! resolved external shear stress (for bcc this already contains non Schmid effects) type(p_vec), intent(in) :: state ! microstructural state !*** input/output variables !*** output variables -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))), & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))), & intent(out) :: v ! velocity -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))), & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))), & intent(out), optional :: dv_dtau ! velocity derivative with respect to resolved shear stress !*** local variables -integer(pInt) instance, & ! current instance of this constitution +integer(pInt) instance, & ! current instance of this plasticity ns, & ! short notation for the total number of active slip systems s ! index of my current slip system -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & tauThreshold ! threshold shear stress real(pReal) tauRel_P, & tauRel_S, & @@ -1277,7 +1277,7 @@ real(pReal) tauRel_P, & mobility ! dislocation mobility -instance = phase_constitutionInstance(material_phase(g,ip,el)) +instance = phase_plasticityInstance(material_phase(g,ip,el)) ns = constitutive_nonlocal_totalNslip(instance) tauThreshold = state%p(11_pInt*ns+1:12_pInt*ns) @@ -1390,7 +1390,7 @@ use debug, only: debug_what, & debug_e use material, only: homogenization_maxNgrains, & material_phase, & - phase_constitutionInstance + phase_plasticityInstance use lattice, only: lattice_Sslip, & lattice_Sslip_v @@ -1411,7 +1411,7 @@ real(pReal), dimension(3,3), intent(out) :: Lp ! plasti real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 ! derivative of Lp with respect to Tstar (9x9 matrix) !*** local variables -integer(pInt) myInstance, & ! current instance of this constitution +integer(pInt) myInstance, & ! current instance of this plasticity myStructure, & ! current lattice structure ns, & ! short notation for the total number of active slip systems c, & @@ -1423,11 +1423,11 @@ integer(pInt) myInstance, & ! curren s, & ! index of my current slip system sLattice ! index of my current slip system according to lattice order real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 ! derivative of Lp with respect to Tstar (3x3x3x3 matrix) -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),4) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),4) :: & rhoSgl, & ! single dislocation densities (including used) v, & ! velocity dv_dtau ! velocity derivative with respect to the shear stress -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & tau, & ! resolved shear stress including non Schmid and backstress terms gdotTotal, & ! shear rate dgdotTotal_dtau, & ! derivative of the shear rate with respect to the shear stress @@ -1439,7 +1439,7 @@ real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstan Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_nonlocal_structure(myInstance) ns = constitutive_nonlocal_totalNslip(myInstance) @@ -1554,9 +1554,9 @@ use mesh, only: mesh_NcpElems, & mesh_ipAreaNormal use material, only: homogenization_maxNgrains, & material_phase, & - phase_constitutionInstance, & - phase_localConstitution, & - phase_constitution + phase_plasticityInstance, & + phase_localPlasticity, & + phase_plasticity use lattice, only: lattice_Sslip_v, & lattice_sd, & lattice_st @@ -1583,7 +1583,7 @@ type(p_vec), intent(inout) :: dotState ! evolutio !*** output variables !*** local variables -integer(pInt) myInstance, & ! current instance of this constitution +integer(pInt) myInstance, & ! current instance of this plasticity myStructure, & ! current lattice structure ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation @@ -1598,7 +1598,7 @@ integer(pInt) myInstance, & ! current topp, & ! type of dislocation with opposite sign to t s, & ! index of my current slip system sLattice ! index of my current slip system according to lattice order -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),10) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),10) :: & rhoDot, & ! density evolution rhoDotRemobilization, & ! density evolution by remobilization rhoDotMultiplication, & ! density evolution by multiplication @@ -1606,24 +1606,24 @@ real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstan rhoDotSingle2DipoleGlide, & ! density evolution by dipole formation (by glide) rhoDotAthermalAnnihilation, & ! density evolution by athermal annihilation rhoDotThermalAnnihilation ! density evolution by thermal annihilation -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),8) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),8) :: & rhoSgl ! current single dislocation densities (positive/negative screw and edge without dipoles) -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),4) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),4) :: & v, & ! dislocation glide velocity fluxdensity, & ! flux density at central material point neighboring_fluxdensity, & ! flux density at neighboring material point gdot ! shear rates -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & rhoForest, & ! forest dislocation density tauThreshold, & ! threshold shear stress tau, & ! current resolved shear stress tauBack, & ! current back stress from pileups on same slip system vClimb ! climb velocity of edge dipoles -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),2) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),2) :: & rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) dLower, & ! minimum stable dipole distance for edges and screws dUpper ! current maximum stable dipole distance for edges and screws -real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),4) :: & +real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),4) :: & m ! direction of dislocation motion real(pReal), dimension(3,3) :: my_F, & ! my total deformation gradient neighboring_F, & ! total deformation gradient of my neighbor @@ -1658,7 +1658,7 @@ select case(mesh_element(2,el)) call IO_error(253_pInt,el,ip,g) end select -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_nonlocal_structure(myInstance) ns = constitutive_nonlocal_totalNslip(myInstance) @@ -1779,11 +1779,11 @@ where (rhoSgl(1:ns,1:2) > 0.0_pReal) & !**************************************************************************** -!*** calculate dislocation fluxes (only for nonlocal constitution) +!*** calculate dislocation fluxes (only for nonlocal plasticity) rhoDotFlux = 0.0_pReal -if (.not. phase_localConstitution(material_phase(g,ip,el))) then ! only for nonlocal constitution +if (.not. phase_localPlasticity(material_phase(g,ip,el))) then ! only for nonlocal plasticity !*** take care of the definition of lattice_st = lattice_sd x lattice_sn !!! !*** opposite sign to our p vector in the (s,p,n) triplet !!! @@ -1827,14 +1827,14 @@ if (.not. phase_localConstitution(material_phase(g,ip,el))) then !* FLUX FROM MY NEIGHBOR TO ME - !* This is only considered, if I have a neighbor of nonlocal constitution (also nonlocal constitutive law with local properties) that is at least a little bit compatible. + !* This is only considered, if I have a neighbor of nonlocal plasticity (also nonlocal constitutive law with local properties) that is at least a little bit compatible. !* If it's not at all compatible, no flux is arriving, because everything is dammed in front of my neighbor's interface. !* The entering flux from my neighbor will be distributed on my slip systems according to the compatibility considerEnteringFlux = .false. neighboring_fluxdensity = 0.0_pReal ! needed for check of sign change in flux density below if (neighboring_el > 0_pInt .or. neighboring_ip > 0_pInt) then - if (phase_constitution(material_phase(1,neighboring_ip,neighboring_el)) == constitutive_nonlocal_label & + if (phase_plasticity(material_phase(1,neighboring_ip,neighboring_el)) == constitutive_nonlocal_label & .and. any(constitutive_nonlocal_compatibility(:,:,:,n,ip,el) > 0.0_pReal)) & considerEnteringFlux = .true. endif @@ -1877,7 +1877,7 @@ if (.not. phase_localConstitution(material_phase(g,ip,el))) then considerLeavingFlux = .true. if (opposite_el > 0_pInt .and. opposite_ip > 0_pInt) then - if (phase_constitution(material_phase(1,opposite_ip,opposite_el)) /= constitutive_nonlocal_label) & + if (phase_plasticity(material_phase(1,opposite_ip,opposite_el)) /= constitutive_nonlocal_label) & considerLeavingFlux = .false. endif @@ -2035,8 +2035,8 @@ use math, only: math_QuaternionDisorientation, & math_mul3x3, & math_qRot use material, only: material_phase, & - phase_localConstitution, & - phase_constitutionInstance, & + phase_localPlasticity, & + phase_plasticityInstance, & homogenization_maxNgrains use mesh, only: mesh_element, & mesh_ipNeighborhood, & @@ -2064,28 +2064,28 @@ integer(pInt) Nneighbors, & ! my_phase, & neighboring_phase, & my_structure, & ! lattice structure - my_instance, & ! instance of constitution + my_instance, & ! instance of plasticity ns, & ! number of active slip systems s1, & ! slip system index (me) s2 ! slip system index (my neighbor) real(pReal), dimension(4) :: absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor -real(pReal), dimension(2,constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(1,i,e))),& - constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(1,i,e))),& +real(pReal), dimension(2,constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& + constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& FE_NipNeighbors(mesh_element(2,e))) :: & compatibility ! compatibility for current element and ip -real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(1,i,e)))) :: & +real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & slipNormal, & slipDirection real(pReal) compatibilitySum, & thresholdValue, & nThresholdValues -logical, dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(1,i,e)))) :: & +logical, dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & belowThreshold Nneighbors = FE_NipNeighbors(mesh_element(2,e)) my_phase = material_phase(1,i,e) -my_instance = phase_constitutionInstance(my_phase) +my_instance = phase_plasticityInstance(my_phase) my_structure = constitutive_nonlocal_structure(my_instance) ns = constitutive_nonlocal_totalNslip(my_instance) slipNormal(1:3,1:ns) = lattice_sn(1:3, constitutive_nonlocal_slipSystemLattice(1:ns,my_instance), my_structure) @@ -2119,12 +2119,12 @@ do n = 1_pInt,Nneighbors !* PHASE BOUNDARY !* If we encounter a different nonlocal "cpfem" phase at the neighbor, !* we consider this to be a real "physical" phase boundary, so completely incompatible. - !* If the neighboring "cpfem" phase has a local constitution, + !* If the neighboring "cpfem" phase has a local plasticity, !* we do not consider this to be a phase boundary, so completely compatible. neighboring_phase = material_phase(1,neighboring_i,neighboring_e) if (neighboring_phase /= my_phase) then - if (.not. phase_localConstitution(neighboring_phase)) then + if (.not. phase_localPlasticity(neighboring_phase)) then forall(s1 = 1_pInt:ns) & compatibility(1:2,s1,s1,n) = 0.0_pReal ! = sqrt(0.0) endif @@ -2233,8 +2233,8 @@ use mesh, only: mesh_NcpElems, & mesh_periodicSurface use material, only: homogenization_maxNgrains, & material_phase, & - phase_localConstitution, & - phase_constitutionInstance + phase_localPlasticity, & + phase_plasticityInstance implicit none @@ -2256,8 +2256,8 @@ real(pReal), dimension(3,3) :: constitutive_nonlocal_dislocationstress !*** local variables integer(pInt) neighboring_el, & ! element number of neighboring material point neighboring_ip, & ! integration point of neighboring material point - instance, & ! my instance of this constitution - neighboring_instance, & ! instance of this constitution of neighboring material point + instance, & ! my instance of this plasticity + neighboring_instance, & ! instance of this plasticity of neighboring material point latticeStruct, & ! my lattice structure neighboring_latticeStruct, & ! lattice structure of neighboring material point phase, & @@ -2299,12 +2299,12 @@ real(pReal), dimension(2,2,maxval(constitutive_nonlocal_totalNslip)) :: & neighboring_rhoExcess ! excess density at neighboring material point (edge/screw,mobile/dead,slipsystem) real(pReal), dimension(2,maxval(constitutive_nonlocal_totalNslip)) :: & rhoExcessDead -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),8) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),8) :: & rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) logical inversionError phase = material_phase(g,ip,el) -instance = phase_constitutionInstance(phase) +instance = phase_plasticityInstance(phase) latticeStruct = constitutive_nonlocal_structure(instance) ns = constitutive_nonlocal_totalNslip(instance) @@ -2320,11 +2320,11 @@ forall (t = 5_pInt:8_pInt) & !*** calculate the dislocation stress of the neighboring excess dislocation densities -!*** zero for material points of local constitution +!*** zero for material points of local plasticity constitutive_nonlocal_dislocationstress = 0.0_pReal -if (.not. phase_localConstitution(phase)) then +if (.not. phase_localPlasticity(phase)) then call math_invert33(Fe(1:3,1:3,g,ip,el), invFe, detFe, inversionError) ! if (inversionError) then ! return @@ -2353,10 +2353,10 @@ if (.not. phase_localConstitution(phase)) then do neighboring_el = 1_pInt,mesh_NcpElems ipLoop: do neighboring_ip = 1_pInt,FE_Nips(mesh_element(2,neighboring_el)) neighboring_phase = material_phase(g,neighboring_ip,neighboring_el) - if (phase_localConstitution(neighboring_phase)) then + if (phase_localPlasticity(neighboring_phase)) then cycle endif - neighboring_instance = phase_constitutionInstance(neighboring_phase) + neighboring_instance = phase_plasticityInstance(neighboring_phase) neighboring_latticeStruct = constitutive_nonlocal_structure(neighboring_instance) neighboring_ns = constitutive_nonlocal_totalNslip(neighboring_instance) call math_invert33(Fe(1:3,1:3,1,neighboring_ip,neighboring_el), neighboring_invFe, detFe, inversionError) @@ -2582,7 +2582,7 @@ use mesh, only: mesh_NcpElems, & mesh_maxNips use material, only: homogenization_maxNgrains, & material_phase, & - phase_constitutionInstance, & + phase_plasticityInstance, & phase_Noutput use lattice, only: lattice_Sslip_v, & lattice_sd, & @@ -2604,11 +2604,11 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in type(p_vec), intent(in) :: dotState ! evolution rate of microstructural state !*** output variables -real(pReal), dimension(constitutive_nonlocal_sizePostResults(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_nonlocal_sizePostResults(phase_plasticityInstance(material_phase(g,ip,el)))) :: & constitutive_nonlocal_postResults !*** local variables -integer(pInt) myInstance, & ! current instance of this constitution +integer(pInt) myInstance, & ! current instance of this plasticity myStructure, & ! current lattice structure ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation @@ -2617,30 +2617,30 @@ integer(pInt) myInstance, & ! current t, & ! type of dislocation s, & ! index of my current slip system sLattice ! index of my current slip system according to lattice order -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),8) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),8) :: & rhoSgl, & ! current single dislocation densities (positive/negative screw and edge without dipoles) rhoDotSgl ! evolution rate of single dislocation densities (positive/negative screw and edge without dipoles) -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),4) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),4) :: & gdot, & ! shear rates v ! velocities -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & rhoForest, & ! forest dislocation density tauThreshold, & ! threshold shear stress tau, & ! current resolved shear stress tauBack, & ! back stress from pileups on same slip system vClimb ! climb velocity of edge dipoles -real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),2) :: & +real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),2) :: & rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) rhoDotDip, & ! evolution rate of dipole dislocation densities (screw and edge dipoles) dLower, & ! minimum stable dipole distance for edges and screws dUpper ! current maximum stable dipole distance for edges and screws -real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_constitutionInstance(material_phase(g,ip,el))),2) :: & +real(pReal), dimension(3,constitutive_nonlocal_totalNslip(phase_plasticityInstance(material_phase(g,ip,el))),2) :: & m, & ! direction of dislocation motion for edge and screw (unit vector) m_currentconf ! direction of dislocation motion for edge and screw (unit vector) in current configuration real(pReal) D ! self diffusion real(pReal), dimension(3,3) :: sigma -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_nonlocal_structure(myInstance) ns = constitutive_nonlocal_totalNslip(myInstance) diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 09ca090d6..ab08bc6ba 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -183,7 +183,7 @@ subroutine constitutive_phenopowerlaw_init(myFile) #include "compilation_info.f90" !$OMP END CRITICAL (write2out) - maxNinstance = int(count(phase_constitution == constitutive_phenopowerlaw_label),pInt) + maxNinstance = int(count(phase_plasticity == constitutive_phenopowerlaw_label),pInt) if (maxNinstance == 0) return if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then @@ -290,8 +290,8 @@ subroutine constitutive_phenopowerlaw_init(myFile) section = section + 1_pInt ! advance section counter cycle ! skip to next line endif - if (section > 0_pInt .and. phase_constitution(section) == constitutive_phenopowerlaw_label) then ! one of my sections - i = phase_constitutionInstance(section) ! which instance of my constitution is present phase + if (section > 0_pInt .and. phase_plasticity(section) == constitutive_phenopowerlaw_label) then ! one of my sections + i = phase_plasticityInstance(section) ! which instance of my constitution is present phase positions = IO_stringPos(line,maxNchunks) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) @@ -612,7 +612,7 @@ function constitutive_phenopowerlaw_homogenizedC(state,ipc,ip,el) !********************************************************************* use prec, only: p_vec use mesh, only: mesh_NcpElems,mesh_maxNips - use material, only: homogenization_maxNgrains,material_phase, phase_constitutionInstance + use material, only: homogenization_maxNgrains,material_phase, phase_plasticityInstance implicit none integer(pInt), intent(in) :: ipc,ip,el @@ -620,7 +620,7 @@ function constitutive_phenopowerlaw_homogenizedC(state,ipc,ip,el) real(pReal), dimension(6,6) :: constitutive_phenopowerlaw_homogenizedC type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: state - matID = phase_constitutionInstance(material_phase(ipc,ip,el)) + matID = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_phenopowerlaw_homogenizedC = constitutive_phenopowerlaw_Cslip_66(:,:,matID) return @@ -639,14 +639,14 @@ subroutine constitutive_phenopowerlaw_microstructure(Temperature,state,ipc,ip,el !********************************************************************* use prec, only: pReal,pInt,p_vec use mesh, only: mesh_NcpElems,mesh_maxNips - use material, only: homogenization_maxNgrains,material_phase, phase_constitutionInstance + use material, only: homogenization_maxNgrains,material_phase, phase_plasticityInstance implicit none integer(pInt) ipc,ip,el, matID real(pReal) Temperature type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: state - matID = phase_constitutionInstance(material_phase(ipc,ip,el)) + matID = phase_plasticityInstance(material_phase(ipc,ip,el)) end subroutine constitutive_phenopowerlaw_microstructure @@ -668,7 +668,7 @@ subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temp use lattice, only: lattice_Sslip,lattice_Sslip_v,lattice_Stwin,lattice_Stwin_v, lattice_maxNslipFamily, lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem use mesh, only: mesh_NcpElems,mesh_maxNips - use material, only: homogenization_maxNgrains,material_phase, phase_constitutionInstance + use material, only: homogenization_maxNgrains,material_phase, phase_plasticityInstance implicit none integer(pInt) ipc,ip,el @@ -679,12 +679,12 @@ subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temp real(pReal), dimension(3,3) :: Lp real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 real(pReal), dimension(9,9) :: dLp_dTstar - real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_constitutionInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip,dgdot_dtauslip,tau_slip - real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_constitutionInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,dgdot_dtautwin,tau_twin - matID = phase_constitutionInstance(material_phase(ipc,ip,el)) + matID = phase_plasticityInstance(material_phase(ipc,ip,el)) structID = constitutive_phenopowerlaw_structure(matID) nSlip = constitutive_phenopowerlaw_totalNslip(matID) @@ -771,7 +771,7 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,Temperature,state,ipc,ip,el use lattice, only: lattice_Sslip_v, lattice_Stwin_v, lattice_maxNslipFamily, lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem,lattice_shearTwin use mesh, only: mesh_NcpElems,mesh_maxNips - use material, only: homogenization_maxNgrains,material_phase, phase_constitutionInstance + use material, only: homogenization_maxNgrains,material_phase, phase_plasticityInstance implicit none integer(pInt) ipc,ip,el @@ -779,14 +779,14 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,Temperature,state,ipc,ip,el real(pReal) Temperature,c_slipslip,c_sliptwin,c_twinslip,c_twintwin, ssat_offset type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: state real(pReal), dimension(6) :: Tstar_v - real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_constitutionInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip,tau_slip,h_slipslip,h_sliptwin - real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_constitutionInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,tau_twin,h_twinslip,h_twintwin - real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(phase_constitutionInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & constitutive_phenopowerlaw_dotState - matID = phase_constitutionInstance(material_phase(ipc,ip,el)) + matID = phase_plasticityInstance(material_phase(ipc,ip,el)) structID = constitutive_phenopowerlaw_structure(matID) nSlip = constitutive_phenopowerlaw_totalNslip(matID) @@ -921,7 +921,7 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,Temperature,dt,stat use lattice, only: lattice_Sslip_v,lattice_Stwin_v, lattice_maxNslipFamily, lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem use mesh, only: mesh_NcpElems,mesh_maxNips - use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance,phase_Noutput + use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance,phase_Noutput implicit none integer(pInt), intent(in) :: ipc,ip,el @@ -930,10 +930,10 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,Temperature,dt,stat type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state integer(pInt) matID,o,f,i,c,nSlip,nTwin,j, structID,index_Gamma,index_F,index_myFamily real(pReal) tau - real(pReal), dimension(constitutive_phenopowerlaw_sizePostResults(phase_constitutionInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(constitutive_phenopowerlaw_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & constitutive_phenopowerlaw_postResults - matID = phase_constitutionInstance(material_phase(ipc,ip,el)) + matID = phase_plasticityInstance(material_phase(ipc,ip,el)) structID = constitutive_phenopowerlaw_structure(matID) nSlip = constitutive_phenopowerlaw_totalNslip(matID) diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90 index a7ddef528..1a720faf6 100644 --- a/code/constitutive_titanmod.f90 +++ b/code/constitutive_titanmod.f90 @@ -258,7 +258,7 @@ write(6,*) '<<<+- constitutive_',trim(constitutive_titanmod_label),' init -+>> write(6,*) '$Id$' #include "compilation_info.f90" -maxNinstance = count(phase_constitution == constitutive_titanmod_label) +maxNinstance = count(phase_plasticity == constitutive_titanmod_label) if (maxNinstance == 0) return !* Space allocation for global variables @@ -427,8 +427,8 @@ enddo section = section + 1_pInt ! advance section counter cycle ! skip to next line endif - if (section > 0_pInt .and. phase_constitution(section) == constitutive_titanmod_label) then ! one of my sections - i = phase_constitutionInstance(section) ! which instance of my constitution is present phase + if (section > 0_pInt .and. phase_plasticity(section) == constitutive_titanmod_label) then ! one of my sections + i = phase_plasticityInstance(section) ! which instance of my constitution is present phase positions = IO_stringPos(line,maxNchunks) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) @@ -1121,21 +1121,21 @@ pure function constitutive_titanmod_homogenizedC(state,g,ip,el) !********************************************************************* use prec, only: pReal,pInt,p_vec use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance implicit none !* Input-Output variables integer(pInt), intent(in) :: g,ip,el type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state real(pReal), dimension(6,6) :: constitutive_titanmod_homogenizedC -real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: & volumefraction_pertwinsystem !* Local variables integer(pInt) myInstance,ns,nt,i real(pReal) sumf !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) ns = constitutive_titanmod_totalNslip(myInstance) nt = constitutive_titanmod_totalNtwin(myInstance) @@ -1170,7 +1170,7 @@ subroutine constitutive_titanmod_microstructure(Temperature,state,g,ip,el) !********************************************************************* use prec, only: pReal,pInt,p_vec use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance implicit none !* Input-Output variables @@ -1180,11 +1180,11 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in !* Local variables integer(pInt) myInstance,myStructure,ns,nt,s,t,i real(pReal) sumf,sfe -real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: & volumefraction_pertwinsystem !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_titanmod_structure(myInstance) ns = constitutive_titanmod_totalNslip(myInstance) nt = constitutive_titanmod_totalNtwin(myInstance) @@ -1288,7 +1288,7 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperatu use prec, only: pReal,pInt,p_vec use math, only: math_Plain3333to99 use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance use lattice, only: lattice_Sslip,lattice_Sslip_v,lattice_Stwin_v,lattice_maxNslipFamily,lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem, lattice_Stwin @@ -1307,13 +1307,13 @@ real(pReal) sumf,StressRatio_edge_p,minusStressRatio_edge_p,StressRatio_edge_pmi screwvelocity_prefactor,twinStressRatio_p,twinminusStressRatio_p,twinStressRatio_pminus1, & twinDotGamma0,BoltzmannRatioscrew,BoltzmannRatiotwin,bottomstress_edge,bottomstress_screw real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 -real(pReal), dimension(constitutive_titanmod_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & gdot_slip,dgdot_dtauslip,tau_slip, edge_velocity, screw_velocity,gdot_slip_edge,gdot_slip_screw -real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: & gdot_twin,dgdot_dtautwin,tau_twin, volumefraction_pertwinsystem !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_titanmod_structure(myInstance) ns = constitutive_titanmod_totalNslip(myInstance) nt = constitutive_titanmod_totalNtwin(myInstance) @@ -1593,7 +1593,7 @@ function constitutive_titanmod_dotState(Tstar_v,Temperature,state,g,ip,el) use prec, only: pReal,pInt,p_vec use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase, phase_constitutionInstance +use material, only: homogenization_maxNgrains,material_phase, phase_plasticityInstance use lattice, only: lattice_maxNslipFamily,lattice_maxNtwinFamily, & lattice_NslipSystem,lattice_NtwinSystem, lattice_Stwin_v @@ -1603,21 +1603,21 @@ integer(pInt), intent(in) :: g,ip,el real(pReal), intent(in) :: Temperature real(pReal), dimension(6), intent(in) :: Tstar_v type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state -real(pReal), dimension(constitutive_titanmod_sizeDotState(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_sizeDotState(phase_plasticityInstance(material_phase(g,ip,el)))) :: & constitutive_titanmod_dotState !* Local variables integer(pInt) MyInstance,MyStructure,ns,nt,f,i,j,index_myFamily real(pReal) sumf,BoltzmannRatio,& twinStressRatio_p,twinminusStressRatio_p -real(pReal), dimension(constitutive_titanmod_totalNslip(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_totalNslip(phase_plasticityInstance(material_phase(g,ip,el)))) :: & DotRhoEdgeGeneration,DotRhoEdgeAnnihilation,DotRhoScrewAnnihilation,& DotRhoScrewGeneration -real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: gdot_twin, & +real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: gdot_twin, & tau_twin, & volumefraction_pertwinsystem !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) MyStructure = constitutive_titanmod_structure(myInstance) ns = constitutive_titanmod_totalNslip(myInstance) nt = constitutive_titanmod_totalNtwin(myInstance) @@ -1766,7 +1766,7 @@ pure function constitutive_titanmod_postResults(Tstar_v,Temperature,dt,state,g,i !********************************************************************* use prec, only: pReal,pInt,p_vec use mesh, only: mesh_NcpElems,mesh_maxNips -use material, only: homogenization_maxNgrains,material_phase,phase_constitutionInstance,phase_Noutput +use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance,phase_Noutput implicit none integer(pInt), intent(in) :: g,ip,el @@ -1775,13 +1775,13 @@ real(pReal), dimension(6), intent(in) :: Tstar_v type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state integer(pInt) myInstance,myStructure,ns,nt,o,i,c real(pReal) sumf -real(pReal), dimension(constitutive_titanmod_sizePostResults(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_sizePostResults(phase_plasticityInstance(material_phase(g,ip,el)))) :: & constitutive_titanmod_postResults -real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_constitutionInstance(material_phase(g,ip,el)))) :: & +real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: & volumefraction_pertwinsystem !* Shortened notation -myInstance = phase_constitutionInstance(material_phase(g,ip,el)) +myInstance = phase_plasticityInstance(material_phase(g,ip,el)) myStructure = constitutive_titanmod_structure(myInstance) ns = constitutive_titanmod_totalNslip(myInstance) nt = constitutive_titanmod_totalNtwin(myInstance) diff --git a/code/crystallite.f90 b/code/crystallite.f90 index a09770bf6..ad0418487 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -96,7 +96,7 @@ real(pReal), dimension (:,:,:,:,:,:,:), allocatable :: & crystallite_partioneddPdF0, & ! individual dPdF per grain at start of homog inc crystallite_fallbackdPdF ! dPdF fallback for non-converged grains (elastic prediction) logical, dimension (:,:,:), allocatable :: & - crystallite_localConstitution, & ! indicates this grain to have purely local constitutive law + crystallite_localPlasticity, & ! indicates this grain to have purely local constitutive law crystallite_requested, & ! flag to request crystallite calculation crystallite_todo, & ! flag to indicate need for further computation crystallite_converged ! convergence flag @@ -225,7 +225,7 @@ allocate(crystallite_orientation0(4,gMax,iMax,eMax)); crystallit allocate(crystallite_rotation(4,gMax,iMax,eMax)); crystallite_rotation = 0.0_pReal allocate(crystallite_disorientation(4,nMax,gMax,iMax,eMax)); crystallite_disorientation = 0.0_pReal allocate(crystallite_symmetryID(gMax,iMax,eMax)); crystallite_symmetryID = 0_pInt -allocate(crystallite_localConstitution(gMax,iMax,eMax)); crystallite_localConstitution = .true. +allocate(crystallite_localPlasticity(gMax,iMax,eMax)); crystallite_localPlasticity = .true. allocate(crystallite_requested(gMax,iMax,eMax)); crystallite_requested = .false. allocate(crystallite_todo(gMax,iMax,eMax)); crystallite_todo = .false. allocate(crystallite_converged(gMax,iMax,eMax)); crystallite_converged = .true. @@ -325,7 +325,7 @@ close(myFile) do g = 1_pInt,myNgrains crystallite_Fp0(1:3,1:3,g,i,e) = math_EulerToR(material_EulerAngles(1:3,g,i,e)) ! plastic def gradient reflects init orientation crystallite_F0(1:3,1:3,g,i,e) = math_I3 - crystallite_localConstitution(g,i,e) = phase_localConstitution(material_phase(g,i,e)) + crystallite_localPlasticity(g,i,e) = phase_localPlasticity(material_phase(g,i,e)) !$OMP FLUSH(crystallite_Fp0) crystallite_Fe(1:3,1:3,g,i,e) = math_transpose33(crystallite_Fp0(1:3,1:3,g,i,e)) crystallite_Fp(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) @@ -348,8 +348,8 @@ crystallite_requested = .true. do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1_pInt,myNgrains myPhase = material_phase(g,i,e) - myMat = phase_constitutionInstance(myPhase) - select case (phase_constitution(myPhase)) + myMat = phase_plasticityInstance(myPhase) + select case (phase_plasticity(myPhase)) case (constitutive_phenopowerlaw_label) myStructure = constitutive_phenopowerlaw_structure(myMat) case (constitutive_titanmod_label) @@ -430,14 +430,14 @@ if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFrac: ', shape(crystallite_subFrac) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subStep: ', shape(crystallite_subStep) write(6,'(a35,1x,7(i8,1x))') 'crystallite_stateDamper: ', shape(crystallite_stateDamper) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_localConstitution: ', shape(crystallite_localConstitution) + write(6,'(a35,1x,7(i8,1x))') 'crystallite_localPlasticity: ', shape(crystallite_localPlasticity) write(6,'(a35,1x,7(i8,1x))') 'crystallite_requested: ', shape(crystallite_requested) write(6,'(a35,1x,7(i8,1x))') 'crystallite_todo: ', shape(crystallite_todo) write(6,'(a35,1x,7(i8,1x))') 'crystallite_converged: ', shape(crystallite_converged) write(6,'(a35,1x,7(i8,1x))') 'crystallite_sizePostResults: ', shape(crystallite_sizePostResults) write(6,'(a35,1x,7(i8,1x))') 'crystallite_sizePostResult: ', shape(crystallite_sizePostResult) write(6,*) - write(6,*) 'Number of nonlocal grains: ',count(.not. crystallite_localConstitution) + write(6,*) 'Number of nonlocal grains: ',count(.not. crystallite_localPlasticity) call flush(6) !$OMP END CRITICAL (write2out) endif @@ -1194,9 +1194,9 @@ RK4dotTemperature = 0.0_pReal if (crystallite_todo(g,i,e)) then if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p) & ! NaN occured in dotState .or. crystallite_dotTemperature(g,i,e) /= crystallite_dotTemperature(g,i,e) ) then ! NaN occured in dotTemperature - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -1284,9 +1284,9 @@ do n = 1_pInt,4_pInt endif endif else ! broken stress integration - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -1317,9 +1317,9 @@ do n = 1_pInt,4_pInt if (crystallite_todo(g,i,e)) then if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p) & ! NaN occured in dotState .or. crystallite_dotTemperature(g,i,e) /= crystallite_dotTemperature(g,i,e) ) then ! NaN occured in dotTemperature - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -1339,8 +1339,8 @@ enddo crystallite_todo = .false. ! done with integration if (.not. singleRun) then ! if not requesting Integration of just a single IP - if (any(.not. crystallite_converged .and. .not. crystallite_localConstitution)) then ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localConstitution ! ...restart all non-local as not converged + if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) then ! any non-local not yet converged (or broken)... + crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif endif @@ -1505,9 +1505,9 @@ endif if (crystallite_todo(g,i,e)) then if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p) & ! NaN occured in dotState .or. crystallite_dotTemperature(g,i,e) /= crystallite_dotTemperature(g,i,e) ) then ! NaN occured in dotTemperature - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -1607,9 +1607,9 @@ do n = 1_pInt,5_pInt 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 if (crystallite_todo(g,i,e)) then if (.not. crystallite_integrateStress(g,i,e,c(n))) then ! fraction of original time step - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -1642,9 +1642,9 @@ do n = 1_pInt,5_pInt if (crystallite_todo(g,i,e)) then if ( any(constitutive_dotState(g,i,e)%p/=constitutive_dotState(g,i,e)%p) & ! NaN occured in dotState .or. crystallite_dotTemperature(g,i,e)/=crystallite_dotTemperature(g,i,e) ) then ! NaN occured in dotTemperature - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -1796,9 +1796,9 @@ relTemperatureResiduum = 0.0_pReal !$OMP END CRITICAL (distributionState) endif else - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped !$OMP END CRITICAL (checkTodo) endif endif @@ -1817,8 +1817,8 @@ relTemperatureResiduum = 0.0_pReal endif #endif if (.not. singleRun) then ! if not requesting Integration of just a single IP - if ( any(.not. crystallite_converged .and. .not. crystallite_localConstitution)) then ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localConstitution ! ...restart all non-local as not converged + if ( any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) then ! any non-local not yet converged (or broken)... + crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif endif @@ -1936,9 +1936,9 @@ if (numerics_integrationMode < 2) then if (crystallite_todo(g,i,e)) then if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p) & ! NaN occured in dotState .or. crystallite_dotTemperature(g,i,e) /= crystallite_dotTemperature(g,i,e) ) then ! NaN occured in dotTemperature - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -1987,9 +1987,9 @@ endif 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 if (crystallite_todo(g,i,e)) then if (.not. crystallite_integrateStress(g,i,e)) then - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -2017,9 +2017,9 @@ endif if (crystallite_todo(g,i,e)) then if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p) & ! NaN occured in dotState .or. crystallite_dotTemperature(g,i,e) /= crystallite_dotTemperature(g,i,e) ) then ! NaN occured in dotTemperature - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -2105,8 +2105,8 @@ relTemperatureResiduum = 0.0_pReal endif #endif if (.not. singleRun) then ! if not requesting Integration of just a single IP - if ( any(.not. crystallite_converged .and. .not. crystallite_localConstitution)) then ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localConstitution ! ...restart all non-local as not converged + if ( any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) then ! any non-local not yet converged (or broken)... + crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif endif @@ -2205,9 +2205,9 @@ if (numerics_integrationMode < 2) then if (crystallite_todo(g,i,e)) then if ( any(constitutive_dotState(g,i,e)%p/=constitutive_dotState(g,i,e)%p) & ! NaN occured in dotState .or. crystallite_dotTemperature(g,i,e)/=crystallite_dotTemperature(g,i,e) ) then ! NaN occured in dotTemperature - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + 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 @@ -2273,9 +2273,9 @@ endif !$OMP END CRITICAL (distributionState) endif else ! broken stress integration - if (.not. crystallite_localConstitution(g,i,e)) then ! if broken non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped !$OMP END CRITICAL (checkTodo) endif endif @@ -2290,8 +2290,8 @@ endif crystallite_todo = .false. ! done with integration if (.not. singleRun) then ! if not requesting Integration of just a single IP - if (any(.not. crystallite_converged .and. .not. crystallite_localConstitution)) then ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localConstitution ! ...restart all non-local as not converged + if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) then ! any non-local not yet converged (or broken)... + crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif endif @@ -2406,9 +2406,9 @@ endif call crystallite_updateTemperature(temperatureUpdateDone, temperatureConverged, g,i,e) ! update temperature crystallite_todo(g,i,e) = stateUpdateDone .and. temperatureUpdateDone if ( (.not. stateUpdateDone .or. .not. temperatureUpdateDone) & - .and. .not. crystallite_localConstitution(g,i,e) ) then ! if updateState or updateTemperature signals broken non-local... + .and. .not. crystallite_localPlasticity(g,i,e) ) then ! if updateState or updateTemperature signals broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped !$OMP END CRITICAL (checkTodo) endif endif @@ -2447,9 +2447,9 @@ do while (any(crystallite_todo) .and. NiterationState < nState ) 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 if (crystallite_todo(g,i,e)) then if (.not. crystallite_integrateStress(g,i,e)) then ! if broken ... - if (.not. crystallite_localConstitution(g,i,e)) then ! ... and non-local... + if (.not. crystallite_localPlasticity(g,i,e)) then ! ... and non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ... then all non-locals skipped + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ... then all non-locals skipped !$OMP END CRITICAL (checkTodo) else ! ... and local... crystallite_todo(g,i,e) = .false. ! ... then skip only me @@ -2508,9 +2508,9 @@ do while (any(crystallite_todo) .and. NiterationState < nState ) crystallite_todo(g,i,e) = stateUpdateDone .and. temperatureUpdateDone crystallite_converged(g,i,e) = stateConverged .and. temperatureConverged if ( (.not. stateUpdateDone .or. .not. temperatureUpdateDone) & - .and. .not. crystallite_localConstitution(g,i,e) ) then ! if updateState or updateTemperature signals broken non-local... + .and. .not. crystallite_localPlasticity(g,i,e) ) then ! if updateState or updateTemperature signals broken non-local... !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localConstitution ! ...all non-locals skipped + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped !$OMP END CRITICAL (checkTodo) elseif (stateConverged .and. temperatureConverged) then ! check (private) logicals "stateConverged" and "temperatureConverged" instead of (shared) "crystallite_converged", so no need to flush the "crystallite_converged" array if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then @@ -2553,8 +2553,8 @@ do while (any(crystallite_todo) .and. NiterationState < nState ) ! --- CONVERGENCE CHECK --- if (.not. singleRun) then ! if not requesting Integration of just a single IP - if (any(.not. crystallite_converged .and. .not. crystallite_localConstitution)) then ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localConstitution ! ...restart all non-local as not converged + if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) then ! any non-local not yet converged (or broken)... + crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif endif crystallite_todo = crystallite_todo .and. .not. crystallite_converged ! skip all converged @@ -3191,8 +3191,8 @@ use FEsolving, only: FEsolving_execElem, & use IO, only: IO_warning use material, only: material_phase, & homogenization_Ngrains, & - phase_localConstitution, & - phase_constitutionInstance + phase_localPlasticity, & + phase_plasticityInstance use mesh, only: mesh_element, & mesh_ipNeighborhood, & FE_NipNeighbors @@ -3214,7 +3214,7 @@ integer(pInt) e, & ! element index neighboring_i, & ! integration point index of my neighbor myPhase, & ! phase neighboringPhase, & - myInstance, & ! instance of constitution + myInstance, & ! instance of plasticity neighboringInstance, & myStructure, & ! lattice structure neighboringStructure @@ -3254,8 +3254,8 @@ logical error do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) myPhase = material_phase(1,i,e) ! get my phase - if (.not. phase_localConstitution(myPhase)) then ! if nonlocal model - myInstance = phase_constitutionInstance(myPhase) + if (.not. phase_localPlasticity(myPhase)) then ! if nonlocal model + myInstance = phase_plasticityInstance(myPhase) myStructure = constitutive_nonlocal_structure(myInstance) ! get my crystal structure @@ -3266,8 +3266,8 @@ logical error neighboring_i = mesh_ipNeighborhood(2,n,i,e) if ((neighboring_e > 0) .and. (neighboring_i > 0)) then ! if neighbor exists neighboringPhase = material_phase(1,neighboring_i,neighboring_e) ! get my neighbor's phase - if (.not. phase_localConstitution(neighboringPhase)) then ! neighbor got also nonlocal constitution - neighboringInstance = phase_constitutionInstance(neighboringPhase) + if (.not. phase_localPlasticity(neighboringPhase)) then ! neighbor got also nonlocal plasticity + neighboringInstance = phase_plasticityInstance(neighboringPhase) neighboringStructure = constitutive_nonlocal_structure(neighboringInstance) ! get my neighbor's crystal structure if (myStructure == neighboringStructure) then ! if my neighbor has same crystal structure like me crystallite_disorientation(:,n,1,i,e) = & @@ -3277,7 +3277,7 @@ logical error else ! for neighbor with different phase crystallite_disorientation(:,n,1,i,e) = (/0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal/) ! 180 degree rotation about 100 axis endif - else ! for neighbor with local constitution + else ! for neighbor with local plasticity crystallite_disorientation(:,n,1,i,e) = (/-1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal/) ! homomorphic identity endif else ! no existing neighbor diff --git a/code/material.f90 b/code/material.f90 index be0c841b3..f5c29e5fc 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -40,7 +40,7 @@ module material material_partPhase = 'phase' character(len=64), dimension(:), allocatable, public :: & - phase_constitution, & !> constitution of each phase + phase_plasticity, & !> plasticity of each phase phase_name, & !> name of each phase homogenization_name, & !> name of each homogenization homogenization_type, & !> type of each homogenization @@ -57,7 +57,7 @@ module material homogenization_Ngrains, & !> number of grains in each homogenization homogenization_Noutput, & !> number of '(output)' items per homogenization phase_Noutput, & !> number of '(output)' items per phase - phase_constitutionInstance, & !> instance of particular constitution of each phase + phase_plasticityInstance, & !> instance of particular plasticity of each phase crystallite_Noutput, & !> number of '(output)' items per crystallite setting homogenization_typeInstance, & !> instance of particular type of each homogenization microstructure_crystallite !> crystallite setting ID of each microstructure @@ -72,7 +72,7 @@ module material logical, dimension(:), allocatable, public :: & microstructure_active, & microstructure_elemhomo, & !> flag to indicate homogeneous microstructure distribution over element's IPs - phase_localConstitution !> flags phases with local constitutive law + phase_localPlasticity !> flags phases with local constitutive law character(len=32), parameter, private :: & @@ -452,13 +452,13 @@ subroutine material_parsePhase(myFile,myPart) if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) allocate(phase_name(Nsections)); phase_name = '' - allocate(phase_constitution(Nsections)); phase_constitution = '' - allocate(phase_constitutionInstance(Nsections)); phase_constitutionInstance = 0_pInt + allocate(phase_plasticity(Nsections)); phase_plasticity = '' + allocate(phase_plasticityInstance(Nsections)); phase_plasticityInstance = 0_pInt allocate(phase_Noutput(Nsections)) - allocate(phase_localConstitution(Nsections)) + allocate(phase_localPlasticity(Nsections)) phase_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections) - phase_localConstitution = .not. IO_spotTagInPart(myFile,myPart,'/nonlocal/',Nsections) + phase_localPlasticity = .not. IO_spotTagInPart(myFile,myPart,'/nonlocal/',Nsections) rewind(myFile) line = '' @@ -480,11 +480,11 @@ subroutine material_parsePhase(myFile,myPart) positions = IO_stringPos(line,maxNchunks) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) - case ('constitution') - phase_constitution(section) = IO_lc(IO_stringValue(line,positions,2_pInt)) + case ('plasticity') + phase_plasticity(section) = IO_lc(IO_stringValue(line,positions,2_pInt)) do s = 1_pInt,section - if (phase_constitution(s) == phase_constitution(section)) & - phase_constitutionInstance(section) = phase_constitutionInstance(section) + 1_pInt ! count instances + if (phase_plasticity(s) == phase_plasticity(section)) & + phase_plasticityInstance(section) = phase_plasticityInstance(section) + 1_pInt ! count instances enddo end select endif