From 8fa2dcffbd52ec553f2646b29e73bd09e10dee81 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 2 Jul 2014 12:27:39 +0000 Subject: [PATCH] changed to new state, please report bugs to Luv or Martin --- code/CPFEM.f90 | 56 +- code/Makefile | 35 +- code/constitutive.f90 | 544 ++-------- code/constitutive_damage.f90 | 23 - code/constitutive_dislotwin.f90 | 679 +++++------- code/constitutive_j2.f90 | 225 ++-- code/constitutive_none.f90 | 47 +- code/constitutive_nonlocal.f90 | 1519 ++++++--------------------- code/constitutive_phenopowerlaw.f90 | 539 +++------- code/constitutive_thermal.f90 | 23 - code/constitutive_titanmod.f90 | 570 ++++------ code/crystallite.f90 | 692 ++---------- code/damage_gradient.f90 | 10 +- code/damage_none.f90 | 10 +- code/homogenization.f90 | 36 +- code/lattice.f90 | 11 - code/material.f90 | 30 +- code/prec.f90 | 9 +- code/thermal_adiabatic.f90 | 11 +- code/thermal_conduction.f90 | 12 +- code/thermal_none.f90 | 9 +- 21 files changed, 1197 insertions(+), 3893 deletions(-) diff --git a/code/CPFEM.f90 b/code/CPFEM.f90 index ad78a046b..b0a1aa96f 100644 --- a/code/CPFEM.f90 +++ b/code/CPFEM.f90 @@ -75,12 +75,10 @@ subroutine CPFEM_initAll(temperature,el,ip) use FEZoo, only: & FEZoo_init #endif -#ifdef NEWSTATE use constitutive_thermal, only: & constitutive_thermal_init use constitutive_damage, only: & constitutive_damage_init -#endif implicit none integer(pInt), intent(in) :: el, & ! FE el number @@ -108,10 +106,8 @@ subroutine CPFEM_initAll(temperature,el,ip) call lattice_init call material_init call constitutive_init -#ifdef NEWSTATE call constitutive_thermal_init call constitutive_damage_init -#endif call crystallite_init(temperature) ! (have to) use temperature of first ip for whole model call homogenization_init call CPFEM_init @@ -156,10 +152,6 @@ subroutine CPFEM_init use material, only: & homogenization_maxNgrains, & material_phase -#ifndef NEWSTATE - use constitutive, only: & - constitutive_state0 -#endif use crystallite, only: & crystallite_F0, & crystallite_Fp0, & @@ -214,7 +206,8 @@ subroutine CPFEM_init call IO_read_realFile(777,'convergedTstar',modelName,size(crystallite_Tstar0_v)) read (777,rec=1) crystallite_Tstar0_v close (777) -#ifndef NEWSTATE + +#ifdef TODO call IO_read_realFile(777,'convergedStateConst',modelName) m = 0_pInt do i = 1,homogenization_maxNgrains; do j = 1,mesh_maxNips; do k = 1,mesh_NcpElems @@ -235,6 +228,8 @@ subroutine CPFEM_init enddo; enddo close (777) #endif + + call IO_read_realFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE)) read (777,rec=1) CPFEM_dcsdE close (777) @@ -303,19 +298,12 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature, dt, el use material, only: & homogenization_maxNgrains, & microstructure_elemhomo, & -#ifdef NEWSTATE - plasticState, & - damageState, & - thermalState, & - mappingConstitutive, & -#endif + plasticState, & + damageState, & + thermalState, & + mappingConstitutive, & material_phase -#ifndef NEWSTATE - use constitutive, only: & - constitutive_state0, & - constitutive_state -#endif - + use crystallite, only: & crystallite_partionedF,& crystallite_F0, & @@ -402,14 +390,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature, dt, el crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress - -#ifndef NEWSTATE - forall ( i = 1:homogenization_maxNgrains, & - j = 1:mesh_maxNips, & - k = 1:mesh_NcpElems ) & - constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites -#endif -#ifdef NEWSTATE forall ( i = 1:size(plasticState)) plasticState(i)%state0= plasticState(i)%state ! copy state in this lenghty way because A component cannot be an array if the encompassing structure is an array forall ( i = 1:size(damageState)) damageState(i)%state0 = damageState(i)%state ! copy state in this lenghty way because A component cannot be an array if the encompassing structure is an array forall ( i = 1:size(thermalState)) thermalState(i)%state0= thermalState(i)%state ! copy state in this lenghty way because A component cannot be an array if the encompassing structure is an array @@ -421,15 +401,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature, dt, el plasticState(mappingConstitutive(2,1,debug_i,debug_e))%state(:,mappingConstitutive(1,1,debug_i,debug_e)) endif endif -#else - if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then - write(6,'(a)') '<< CPFEM >> aging states' - if (debug_e <= mesh_NcpElems .and. debug_i <= mesh_maxNips) then - write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') '<< CPFEM >> aged state of elFE ip grain',& - debug_e, debug_i, 1, constitutive_state(1,debug_i,debug_e)%p - endif - endif -#endif + !$OMP PARALLEL DO do k = 1,mesh_NcpElems do j = 1,mesh_maxNips @@ -468,7 +440,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature, dt, el call IO_write_jobRealFile(777,'convergedTstar',size(crystallite_Tstar0_v)) write (777,rec=1) crystallite_Tstar0_v close (777) -#ifndef NEWSTATE +#ifdef TODO call IO_write_jobRealFile(777,'convergedStateConst') m = 0_pInt do i = 1,homogenization_maxNgrains; do j = 1,mesh_maxNips; do k = 1,mesh_NcpElems @@ -478,7 +450,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature, dt, el enddo enddo; enddo; enddo close (777) -#endif +#endif call IO_write_jobRealFile(777,'convergedStateHomog') m = 0_pInt do k = 1,mesh_NcpElems; do j = 1,mesh_maxNips @@ -648,8 +620,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature, dt, el !*** copy to output if required (FEM solver) - if(present(cauchyStress)) cauchyStress = CPFEM_cs(1:6,ip,elCP) - if(present(jacobian)) jacobian = CPFEM_dcsdE(1:6,1:6,ip,elCP) + if(present(cauchyStress)) cauchyStress = CPFEM_cs (1:6, ip,elCP) + if(present(jacobian)) jacobian = CPFEM_dcsdE(1:6,1:6,ip,elCP) end subroutine CPFEM_general diff --git a/code/Makefile b/code/Makefile index 0c26b0484..903502940 100644 --- a/code/Makefile +++ b/code/Makefile @@ -116,11 +116,6 @@ RUN_PATH :=$(RUN_PATH),-rpath,$(HDF5_ROOT)/lib INCLUDE_DIRS +=-I$(HDF5_ROOT)/include -DHDF endif -#new state -ifeq "$(STATE)" "NEW" -INCLUDE_DIRS +=-DNEWSTATE -endif - ifdef STANDARD_CHECK STANDARD_CHECK_ifort =$(STANDARD_CHECK) STANDARD_CHECK_gfortran =$(STANDARD_CHECK) @@ -350,18 +345,22 @@ PRECISION_gfortran :=-fdefault-real-8 -fdefault-double-8 -DFLOAT=8 -DINT=4 COMPILE =$(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(OPTI)_$(F90)) $(INCLUDE_DIRS) $(PRECISION_$(F90)) -DSpectral COMPILE_MAXOPTI =$(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) $(INCLUDE_DIRS) $(PRECISION_$(F90)) -DSpectral ################################################################################################### +CONSTITUTIVE_FILES = constitutive_thermal.o \ + constitutive_damage.o \ + constitutive_nonlocal.o \ + constitutive_titanmod.o \ + constitutive_dislotwin.o \ + constitutive_phenopowerlaw.o \ + constitutive_j2.o \ + constitutive_none.o + COMPILED_FILES = prec.o DAMASK_spectral_interface.o IO.o libs.o numerics.o debug.o math.o \ FEsolving.o mesh.o material.o lattice.o \ - constitutive_dislotwin.o constitutive_j2.o constitutive_phenopowerlaw.o \ - constitutive_titanmod.o constitutive_nonlocal.o constitutive_none.o constitutive.o crystallite.o \ + damage_none.o damage_gradient.o thermal_none.o thermal_conduction.o thermal_adiabatic.o \ + $(CONSTITUTIVE_FILES) constitutive.o crystallite.o \ homogenization_RGC.o homogenization_isostrain.o homogenization_none.o homogenization.o CPFEM.o \ - DAMASK_spectral_utilities.o DAMASK_spectral_solverBasic.o + DAMASK_spectral_utilities.o DAMASK_spectral_solverBasic.o \ -ifeq "$(STATE)" "NEW" -COMPILED_FILES += constitutive_damage.o damage_none.o damage_gradient.o \ - constitutive_thermal.o thermal_none.o thermal_conduction.o -CONSTITUTIVE_FILES := constitutive_thermal.o constitutive_damage.o -endif ifdef PETSC_DIR PETSC_FILES = DAMASK_spectral_solverAL.o \ @@ -410,15 +409,10 @@ homogenization_none.o: homogenization_none.f90 \ crystallite.o crystallite.o: crystallite.f90 \ - constitutive.o $(CONSTITUTIVE_FILES) + constitutive.o constitutive.o: constitutive.f90 \ - constitutive_nonlocal.o \ - constitutive_titanmod.o \ - constitutive_dislotwin.o \ - constitutive_phenopowerlaw.o \ - constitutive_j2.o \ - constitutive_none.o + $(CONSTITUTIVE_FILES) constitutive_nonlocal.o: constitutive_nonlocal.f90 \ lattice.o @@ -450,6 +444,7 @@ damage_gradient.o: damage_gradient.f90 \ constitutive_thermal.o: constitutive_thermal.f90 \ thermal_none.o \ + thermal_adiabatic.o \ thermal_conduction.o thermal_none.o: thermal_none.f90 \ diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 86ddb8095..f668a680d 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -7,35 +7,12 @@ !-------------------------------------------------------------------------------------------------- module constitutive use prec, only: & - pInt, & - pReal, & - p_vec + pInt implicit none private -#ifndef NEWSTATE - type(p_vec), public, dimension(:,:,:), allocatable :: & - constitutive_state0, & !< pointer array to microstructure at start of BVP inc - constitutive_partionedState0, & !< pointer array to microstructure at start of homogenization inc - constitutive_subState0, & !< pointer array to microstructure at start of crystallite inc - constitutive_state, & !< pointer array to current microstructure (end of converged time step) - constitutive_state_backup, & !< pointer array to backed up microstructure (end of converged time step) - constitutive_dotState, & !< pointer array to evolution of current microstructure - constitutive_deltaState, & !< pointer array to incremental change of current microstructure - constitutive_previousDotState,& !< pointer array to previous evolution of current microstructure - constitutive_previousDotState2,& !< pointer array to 2nd previous evolution of current microstructure - constitutive_dotState_backup, & !< pointer array to backed up evolution of current microstructure - constitutive_RK4dotState, & !< pointer array to evolution of microstructure defined by classical Runge-Kutta method - constitutive_aTolState !< pointer array to absolute state tolerance - type(p_vec), public, dimension(:,:,:,:), allocatable :: & - constitutive_RKCK45dotState !< pointer array to evolution of microstructure used by Cash-Karp Runge-Kutta method integer(pInt), public, dimension(:,:,:), allocatable :: & - constitutive_sizeDotState, & !< size of dotState array - constitutive_sizeState, & !< size of state array per grain constitutive_sizePostResults !< size of postResults array per grain - integer(pInt), private :: & - constitutive_maxSizeState -#endif integer(pInt), public, protected :: & constitutive_maxSizePostResults, & constitutive_maxSizeDotState @@ -68,6 +45,8 @@ subroutine constitutive_init #endif use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + pReal use debug, only: & debug_level, & debug_constitutive, & @@ -112,12 +91,9 @@ subroutine constitutive_init PLASTICITY_PHENOPOWERLAW_label, & PLASTICITY_DISLOTWIN_label, & PLASTICITY_TITANMOD_label, & -#ifdef NEWSTATE plasticState, & -#endif -#if defined(HDF) || defined(NEWSTATE) mappingConstitutive, & -#endif + PLASTICITY_NONLOCAL_label use constitutive_none use constitutive_j2 @@ -214,32 +190,7 @@ subroutine constitutive_init cMax = homogenization_maxNgrains iMax = mesh_maxNips eMax = mesh_NcpElems -#ifndef NEWSTATE -! lumped into new state - allocate(constitutive_state0(cMax,iMax,eMax)) - allocate(constitutive_partionedState0(cMax,iMax,eMax)) - allocate(constitutive_subState0(cMax,iMax,eMax)) - allocate(constitutive_state(cMax,iMax,eMax)) - allocate(constitutive_state_backup(cMax,iMax,eMax)) - allocate(constitutive_dotState(cMax,iMax,eMax)) - allocate(constitutive_deltaState(cMax,iMax,eMax)) - allocate(constitutive_dotState_backup(cMax,iMax,eMax)) - allocate(constitutive_aTolState(cMax,iMax,eMax)) -! not needed anymore for new state - allocate(constitutive_sizeDotState(cMax,iMax,eMax), source=0_pInt) - allocate(constitutive_sizeState(cMax,iMax,eMax), source=0_pInt) - allocate(constitutive_sizePostResults(cMax,iMax,eMax), source=0_pInt) - if (any(numerics_integrator == 1_pInt)) then - allocate(constitutive_previousDotState(cMax,iMax,eMax)) - allocate(constitutive_previousDotState2(cMax,iMax,eMax)) - endif - if (any(numerics_integrator == 4_pInt)) then - allocate(constitutive_RK4dotState(cMax,iMax,eMax)) - endif - if (any(numerics_integrator == 5_pInt)) then - allocate(constitutive_RKCK45dotState(6,cMax,iMax,eMax)) - endif - + allocate(constitutive_sizePostResults(cMax,iMax,eMax), source=0_pInt) ElemLoop:do e = 1_pInt,mesh_NcpElems ! loop over elements myNgrains = homogenization_Ngrains(mesh_element(3,e)) IPloop:do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) ! loop over IPs @@ -251,207 +202,28 @@ subroutine constitutive_init instance = phase_plasticityInstance(phase) select case(phase_plasticity(material_phase(g,i,e))) case (PLASTICITY_NONE_ID) - allocate(constitutive_state0(g,i,e)%p(constitutive_none_sizeState(instance))) - allocate(constitutive_partionedState0(g,i,e)%p(constitutive_none_sizeState(instance))) - allocate(constitutive_subState0(g,i,e)%p(constitutive_none_sizeState(instance))) - allocate(constitutive_state(g,i,e)%p(constitutive_none_sizeState(instance))) - allocate(constitutive_state_backup(g,i,e)%p(constitutive_none_sizeState(instance))) - allocate(constitutive_aTolState(g,i,e)%p(constitutive_none_sizeState(instance))) - allocate(constitutive_dotState(g,i,e)%p(constitutive_none_sizeDotState(instance))) - allocate(constitutive_deltaState(g,i,e)%p(constitutive_none_sizeDotState(instance))) - allocate(constitutive_dotState_backup(g,i,e)%p(constitutive_none_sizeDotState(instance))) - if (any(numerics_integrator == 1_pInt)) then - allocate(constitutive_previousDotState(g,i,e)%p(constitutive_none_sizeDotState(instance))) - allocate(constitutive_previousDotState2(g,i,e)%p(constitutive_none_sizeDotState(instance))) - endif - if (any(numerics_integrator == 4_pInt)) then - allocate(constitutive_RK4dotState(g,i,e)%p(constitutive_none_sizeDotState(instance))) - endif - if (any(numerics_integrator == 5_pInt)) then - do s = 1_pInt,6_pInt - allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_none_sizeDotState(instance))) - enddo - endif - constitutive_state0(g,i,e)%p = 0.0_pReal - constitutive_aTolState(g,i,e)%p = 1.0_pReal - constitutive_sizeState(g,i,e) = 0_pInt - constitutive_sizeDotState(g,i,e) = 0_pInt constitutive_sizePostResults(g,i,e) = 0_pInt - case (PLASTICITY_J2_ID) - allocate(constitutive_state0(g,i,e)%p(constitutive_j2_sizeState(instance))) - allocate(constitutive_partionedState0(g,i,e)%p(constitutive_j2_sizeState(instance))) - allocate(constitutive_subState0(g,i,e)%p(constitutive_j2_sizeState(instance))) - allocate(constitutive_state(g,i,e)%p(constitutive_j2_sizeState(instance))) - allocate(constitutive_state_backup(g,i,e)%p(constitutive_j2_sizeState(instance))) - allocate(constitutive_aTolState(g,i,e)%p(constitutive_j2_sizeState(instance))) - allocate(constitutive_dotState(g,i,e)%p(constitutive_j2_sizeDotState(instance))) - allocate(constitutive_deltaState(g,i,e)%p(constitutive_j2_sizeDotState(instance))) - allocate(constitutive_dotState_backup(g,i,e)%p(constitutive_j2_sizeDotState(instance))) - if (any(numerics_integrator == 1_pInt)) then - allocate(constitutive_previousDotState(g,i,e)%p(constitutive_j2_sizeDotState(instance))) - allocate(constitutive_previousDotState2(g,i,e)%p(constitutive_j2_sizeDotState(instance))) - endif - if (any(numerics_integrator == 4_pInt)) then - allocate(constitutive_RK4dotState(g,i,e)%p(constitutive_j2_sizeDotState(instance))) - endif - if (any(numerics_integrator == 5_pInt)) then - do s = 1_pInt,6_pInt - allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_j2_sizeDotState(instance))) - enddo - endif - constitutive_state0(g,i,e)%p = constitutive_j2_stateInit(instance) - constitutive_aTolState(g,i,e)%p = constitutive_j2_aTolState(instance) - constitutive_sizeState(g,i,e) = constitutive_j2_sizeState(instance) - constitutive_sizeDotState(g,i,e) = constitutive_j2_sizeDotState(instance) constitutive_sizePostResults(g,i,e) = constitutive_j2_sizePostResults(instance) - case (PLASTICITY_PHENOPOWERLAW_ID) - allocate(constitutive_state0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_partionedState0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_subState0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_state(g,i,e)%p(constitutive_phenopowerlaw_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_state_backup(g,i,e)%p(constitutive_phenopowerlaw_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_aTolState(g,i,e)%p(constitutive_phenopowerlaw_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_dotState(g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(instance)),source=0.0_pReal) - allocate(constitutive_deltaState(g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(instance)),source=0.0_pReal) - allocate(constitutive_dotState_backup(g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(instance)),source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(constitutive_previousDotState(g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(instance)),source=0.0_pReal) - allocate(constitutive_previousDotState2(g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(instance)),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) then - allocate(constitutive_RK4dotState(g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(instance)),source=0.0_pReal) - endif - if (any(numerics_integrator == 5_pInt)) then - do s = 1_pInt,6_pInt - allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(instance)),source=0.0_pReal) - enddo - endif - constitutive_state0(g,i,e)%p = constitutive_phenopowerlaw_stateInit(instance) - constitutive_aTolState(g,i,e)%p = constitutive_phenopowerlaw_aTolState(instance) - constitutive_sizeState(g,i,e) = constitutive_phenopowerlaw_sizeState(instance) - constitutive_sizeDotState(g,i,e) = constitutive_phenopowerlaw_sizeDotState(instance) constitutive_sizePostResults(g,i,e) = constitutive_phenopowerlaw_sizePostResults(instance) - case (PLASTICITY_DISLOTWIN_ID) - allocate(constitutive_state0(g,i,e)%p(constitutive_dislotwin_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_partionedState0(g,i,e)%p(constitutive_dislotwin_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_subState0(g,i,e)%p(constitutive_dislotwin_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_state(g,i,e)%p(constitutive_dislotwin_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_state_backup(g,i,e)%p(constitutive_dislotwin_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_aTolState(g,i,e)%p(constitutive_dislotwin_sizeState(instance)),source=0.0_pReal) - allocate(constitutive_dotState(g,i,e)%p(constitutive_dislotwin_sizeDotState(instance)),source=0.0_pReal) - allocate(constitutive_deltaState(g,i,e)%p(constitutive_dislotwin_sizeDotState(instance)),source=0.0_pReal) - allocate(constitutive_dotState_backup(g,i,e)%p(constitutive_dislotwin_sizeDotState(instance)),source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(constitutive_previousDotState(g,i,e)%p(constitutive_dislotwin_sizeDotState(instance)),source=0.0_pReal) - allocate(constitutive_previousDotState2(g,i,e)%p(constitutive_dislotwin_sizeDotState(instance)),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) then - allocate(constitutive_RK4dotState(g,i,e)%p(constitutive_dislotwin_sizeDotState(instance)),source=0.0_pReal) - endif - if (any(numerics_integrator == 5_pInt)) then - do s = 1_pInt,6_pInt - allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_dislotwin_sizeDotState(instance)),source=0.0_pReal) - enddo - endif - constitutive_state0(g,i,e)%p = constitutive_dislotwin_stateInit(instance,material_phase(g,i,e)) - constitutive_aTolState(g,i,e)%p = constitutive_dislotwin_aTolState(instance) - constitutive_sizeState(g,i,e) = constitutive_dislotwin_sizeState(instance) - constitutive_sizeDotState(g,i,e) = constitutive_dislotwin_sizeDotState(instance) constitutive_sizePostResults(g,i,e) = constitutive_dislotwin_sizePostResults(instance) case (PLASTICITY_TITANMOD_ID) - allocate(constitutive_state0(g,i,e)%p(constitutive_titanmod_sizeState(instance))) - allocate(constitutive_partionedState0(g,i,e)%p(constitutive_titanmod_sizeState(instance))) - allocate(constitutive_subState0(g,i,e)%p(constitutive_titanmod_sizeState(instance))) - allocate(constitutive_state(g,i,e)%p(constitutive_titanmod_sizeState(instance))) - allocate(constitutive_state_backup(g,i,e)%p(constitutive_titanmod_sizeState(instance))) - allocate(constitutive_aTolState(g,i,e)%p(constitutive_titanmod_sizeState(instance))) - allocate(constitutive_dotState(g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) - allocate(constitutive_deltaState(g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) - allocate(constitutive_dotState_backup(g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) - if (any(numerics_integrator == 1_pInt)) then - allocate(constitutive_previousDotState(g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) - allocate(constitutive_previousDotState2(g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) - endif - if (any(numerics_integrator == 4_pInt)) then - allocate(constitutive_RK4dotState(g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) - endif - if (any(numerics_integrator == 5_pInt)) then - do s = 1_pInt,6_pInt - allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) - enddo - endif - constitutive_state0(g,i,e)%p = constitutive_titanmod_stateInit(instance,material_phase(g,i,e)) - constitutive_aTolState(g,i,e)%p = constitutive_titanmod_aTolState(instance) - constitutive_sizeState(g,i,e) = constitutive_titanmod_sizeState(instance) - constitutive_sizeDotState(g,i,e) = constitutive_titanmod_sizeDotState(instance) constitutive_sizePostResults(g,i,e) = constitutive_titanmod_sizePostResults(instance) case (PLASTICITY_NONLOCAL_ID) nonlocalConstitutionPresent = .true. - + plasticState(mappingConstitutive(2,g,i,e))%nonlocal = .true. if(myNgrains/=1_pInt) call IO_error(252_pInt, e,i,g) - allocate(constitutive_state0(g,i,e)%p(constitutive_nonlocal_sizeState(instance))) - allocate(constitutive_partionedState0(g,i,e)%p(constitutive_nonlocal_sizeState(instance))) - allocate(constitutive_subState0(g,i,e)%p(constitutive_nonlocal_sizeState(instance))) - allocate(constitutive_state(g,i,e)%p(constitutive_nonlocal_sizeState(instance))) - allocate(constitutive_state_backup(g,i,e)%p(constitutive_nonlocal_sizeState(instance))) - allocate(constitutive_aTolState(g,i,e)%p(constitutive_nonlocal_sizeState(instance))) - allocate(constitutive_dotState(g,i,e)%p(constitutive_nonlocal_sizeDotState(instance))) - allocate(constitutive_deltaState(g,i,e)%p(constitutive_nonlocal_sizeDotState(instance))) - allocate(constitutive_dotState_backup(g,i,e)%p(constitutive_nonlocal_sizeDotState(instance))) - if (any(numerics_integrator == 1_pInt)) then - allocate(constitutive_previousDotState(g,i,e)%p(constitutive_nonlocal_sizeDotState(instance))) - allocate(constitutive_previousDotState2(g,i,e)%p(constitutive_nonlocal_sizeDotState(instance))) - endif - if (any(numerics_integrator == 4_pInt)) then - allocate(constitutive_RK4dotState(g,i,e)%p(constitutive_nonlocal_sizeDotState(instance))) - endif - if (any(numerics_integrator == 5_pInt)) then - do s = 1_pInt,6_pInt - allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_nonlocal_sizeDotState(instance))) - enddo - endif - constitutive_aTolState(g,i,e)%p = constitutive_nonlocal_aTolState(instance) - constitutive_sizeState(g,i,e) = constitutive_nonlocal_sizeState(instance) - constitutive_sizeDotState(g,i,e) = constitutive_nonlocal_sizeDotState(instance) constitutive_sizePostResults(g,i,e) = constitutive_nonlocal_sizePostResults(instance) end select enddo GrainLoop enddo IPloop enddo ElemLoop -#endif -#ifdef NEWSTATE - PhaseLoop:do phase = 1_pInt,material_Nphase ! loop over phases - instance = phase_plasticityInstance(phase) - select case(phase_plasticity(phase)) - case (PLASTICITY_NONE_ID) - plasticState(phase)%sizePostResults = constitutive_none_sizePostResults(instance) - case (PLASTICITY_J2_ID) - plasticState(phase)%sizePostResults = constitutive_j2_sizePostResults(instance) - case (PLASTICITY_PHENOPOWERLAW_ID) - plasticState(phase)%sizePostResults = constitutive_none_sizePostResults(instance) - case (PLASTICITY_DISLOTWIN_ID) - plasticState(phase)%sizePostResults = constitutive_dislotwin_sizePostResults(instance) - case (PLASTICITY_TITANMOD_ID) - plasticState(phase)%sizePostResults = constitutive_titanmod_sizePostResults(instance) - case (PLASTICITY_NONLOCAL_ID) - nonlocalConstitutionPresent = .true. - plasticState(phase)%nonlocal = .true. - plasticState(phase)%sizePostResults = constitutive_nonlocal_sizePostResults(instance) - end select - enddo PhaseLoop -#endif - if (nonlocalConstitutionPresent) & -#ifdef NEWSTATE + if (nonlocalConstitutionPresent) & call constitutive_nonlocal_stateInit() -#else - call constitutive_nonlocal_stateInit(constitutive_state0(1,1:iMax,1:eMax)) -#endif -#ifdef NEWSTATE do e = 1_pInt,mesh_NcpElems ! loop over elements myNgrains = homogenization_Ngrains(mesh_element(3,e)) forall(i = 1_pInt:FE_Nips(FE_geomtype(mesh_element(2,e))), g = 1_pInt:myNgrains) @@ -461,16 +233,6 @@ subroutine constitutive_init plasticState(mappingConstitutive(2,g,i,e))%State0(:,mappingConstitutive(1,g,i,e)) ! need to be defined for first call of constitutive_microstructure in crystallite_init endforall enddo -#else - do e = 1_pInt,mesh_NcpElems ! loop over elements - myNgrains = homogenization_Ngrains(mesh_element(3,e)) - forall(i = 1_pInt:FE_Nips(FE_geomtype(mesh_element(2,e))), g = 1_pInt:myNgrains) - constitutive_partionedState0(g,i,e)%p = constitutive_state0(g,i,e)%p - constitutive_state(g,i,e)%p = constitutive_state0(g,i,e)%p ! need to be defined for first call of constitutive_microstructure in crystallite_init - endforall - enddo -#endif - #ifdef HDF call HDF5_mappingConstitutive(mappingConstitutive) @@ -483,7 +245,7 @@ subroutine constitutive_init enddo #endif -#ifndef NEWSTATE +#ifdef TODO !-------------------------------------------------------------------------------------------------- ! write out state size file call IO_write_jobIntFile(777,'sizeStateConst', size(constitutive_sizeState)) @@ -512,29 +274,30 @@ subroutine constitutive_init write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', constitutive_maxSizePostResults endif flush(6) -#else +#endif + constitutive_maxSizePostResults = 0_pInt constitutive_maxSizeDotState = 0_pInt do p = 1, size(plasticState) constitutive_maxSizeDotState = max(constitutive_maxSizeDotState, plasticState(p)%sizeDotState) constitutive_maxSizePostResults = max(constitutive_maxSizePostResults, plasticState(p)%sizePostResults) enddo -#endif + end subroutine constitutive_init !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenize elasticity matrix !-------------------------------------------------------------------------------------------------- -pure function constitutive_homogenizedC(ipc,ip,el) +function constitutive_homogenizedC(ipc,ip,el) + use prec, only: & + pReal use material, only: & phase_plasticity, & material_phase, & PLASTICITY_TITANMOD_ID, & -#ifdef NEWSTATE plasticState,& mappingConstitutive, & -#endif PLASTICITY_DISLOTWIN_ID use constitutive_titanmod, only: & constitutive_titanmod_homogenizedC @@ -553,27 +316,11 @@ pure function constitutive_homogenizedC(ipc,ip,el) select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_DISLOTWIN_ID) -#ifdef NEWSTATE - constitutive_homogenizedC = constitutive_dislotwin_homogenizedC & - (plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)), & - ipc,ip,el) - -#else - constitutive_homogenizedC = constitutive_dislotwin_homogenizedC & - (constitutive_state(ipc,ip,el),ipc,ip,el) -#endif + constitutive_homogenizedC = constitutive_dislotwin_homogenizedC(ipc,ip,el) case (PLASTICITY_TITANMOD_ID) -#ifdef NEWSTATE - - constitutive_homogenizedC = constitutive_titanmod_homogenizedC & - (plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)), & - ipc,ip,el) -#else - constitutive_homogenizedC = constitutive_titanmod_homogenizedC(constitutive_state(ipc,ip,el), & - ipc,ip,el) -#endif + constitutive_homogenizedC = constitutive_titanmod_homogenizedC (ipc,ip,el) case default - constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phase(ipc,ip,el)) + constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phase (ipc,ip,el)) end select @@ -584,14 +331,14 @@ end function constitutive_homogenizedC !> @brief calls microstructure function of the different constitutive models !-------------------------------------------------------------------------------------------------- subroutine constitutive_microstructure(temperature, Fe, Fp, ipc, ip, el) + use prec, only: & + pReal use material, only: & phase_plasticity, & material_phase, & PLASTICITY_DISLOTWIN_ID, & -#ifdef NEWSTATE plasticState, & mappingConstitutive, & -#endif PLASTICITY_TITANMOD_ID, & PLASTICITY_NONLOCAL_ID use constitutive_titanmod, only: & @@ -615,30 +362,12 @@ subroutine constitutive_microstructure(temperature, Fe, Fp, ipc, ip, el) select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_DISLOTWIN_ID) -#ifdef NEWSTATE - call constitutive_dislotwin_microstructure(temperature, & - plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)), & - ipc,ip,el) -#else - call constitutive_dislotwin_microstructure(temperature,constitutive_state(ipc,ip,el), & - ipc,ip,el) -#endif - + call constitutive_dislotwin_microstructure(temperature,ipc,ip,el) case (PLASTICITY_TITANMOD_ID) -#ifdef NEWSTATE - call constitutive_titanmod_microstructure(temperature, & - plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)), & - ipc,ip,el) -#else - call constitutive_titanmod_microstructure(temperature,constitutive_state(ipc,ip,el), & - ipc,ip,el) -#endif + call constitutive_titanmod_microstructure (temperature,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) -#ifdef NEWSTATE - call constitutive_nonlocal_microstructure(Fe,Fp,ipc,ip,el) -#else - call constitutive_nonlocal_microstructure(constitutive_state,Fe,Fp,ipc,ip,el) -#endif + call constitutive_nonlocal_microstructure (Fe,Fp, ip,el) + end select end subroutine constitutive_microstructure @@ -648,15 +377,15 @@ end subroutine constitutive_microstructure !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, temperature, ipc, ip, el) + use prec, only: & + pReal use math, only: & math_identity2nd use material, only: & phase_plasticity, & material_phase, & -#ifdef NEWSTATE plasticState,& mappingConstitutive, & -#endif PLASTICITY_NONE_ID, & PLASTICITY_J2_ID, & PLASTICITY_PHENOPOWERLAW_ID, & @@ -693,50 +422,17 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, temperature, ip case (PLASTICITY_NONE_ID) Lp = 0.0_pReal dLp_dTstar = math_identity2nd(9) - case (PLASTICITY_J2_ID) -#ifdef NEWSTATE - call constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v, & - plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)),ipc,ip,el) -#else - call constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v, & - constitutive_state(ipc,ip,el),ipc,ip,el) -#endif + call constitutive_j2_LpAndItsTangent (Lp,dLp_dTstar,Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) -#ifdef NEWSTATE - call constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v, & - plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)),ipc,ip,el) -#else - call constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v, & - constitutive_state(ipc,ip,el),ipc,ip,el) -#endif - case (PLASTICITY_DISLOTWIN_ID) -#ifdef NEWSTATE - call constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,temperature, & - plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)), & - ipc,ip,el) -#else - call constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v, & - temperature,constitutive_state(ipc,ip,el),ipc,ip,el) -#endif - - case (PLASTICITY_TITANMOD_ID) -#ifdef NEWSTATE - call constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,temperature, & - plasticState(mappingConstitutive(2,ipc,ip,el))%state(:,mappingConstitutive(1,ipc,ip,el)), & - ipc,ip,el) -#else - call constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v, & - temperature,constitutive_state(ipc,ip,el),ipc,ip,el) -#endif + call constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) -#ifdef NEWSTATE - call constitutive_nonlocal_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, & - temperature, ipc,ip,el) -#else - call constitutive_nonlocal_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, & - temperature, constitutive_state(ipc,ip,el), ipc,ip,el) -#endif + call constitutive_nonlocal_LpAndItsTangent (Lp,dLp_dTstar,Tstar_v,temperature, ip,el) + case (PLASTICITY_DISLOTWIN_ID) + call constitutive_dislotwin_LpAndItsTangent (Lp,dLp_dTstar,Tstar_v,temperature,ipc,ip,el) + case (PLASTICITY_TITANMOD_ID) + call constitutive_titanmod_LpAndItsTangent (Lp,dLp_dTstar,Tstar_v,temperature,ipc,ip,el) + end select end subroutine constitutive_LpAndItsTangent @@ -748,8 +444,10 @@ end subroutine constitutive_LpAndItsTangent !> the elastic deformation gradient depending on the selected elastic law (so far no case switch !! because only hooke is implemented !-------------------------------------------------------------------------------------------------- -pure subroutine constitutive_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el) - +subroutine constitutive_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el) + use prec, only: & + pReal + implicit none integer(pInt), intent(in) :: & ipc, & !< grain number @@ -772,28 +470,28 @@ end subroutine constitutive_TandItsTangent !> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to !> the elastic deformation gradient using hookes law !-------------------------------------------------------------------------------------------------- -pure subroutine constitutive_hooke_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el) -use math, only : & - math_mul3x3, & - math_mul33x33, & - math_mul3333xx33, & - math_Mandel66to3333, & - math_transpose33, & - MATH_I3 -#ifdef NEWSTATE -use material, only: & - mappingConstitutive, & - damageState, & - phase_damage, & - DAMAGE_gradient_ID, & - thermalState, & - phase_thermal, & - THERMAL_conduction_ID, & - THERMAL_adiabatic_ID +subroutine constitutive_hooke_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el) + use prec, only: & + pReal + use math, only : & + math_mul3x3, & + math_mul33x33, & + math_mul3333xx33, & + math_Mandel66to3333, & + math_transpose33, & + MATH_I3 + use material, only: & + mappingConstitutive, & + damageState, & + phase_damage, & + DAMAGE_gradient_ID, & + thermalState, & + phase_thermal, & + THERMAL_conduction_ID, & + THERMAL_adiabatic_ID use lattice, only: & - lattice_referenceTemperature, & - lattice_thermalExpansion33 -#endif + lattice_referenceTemperature, & + lattice_thermalExpansion33 implicit none integer(pInt), intent(in) :: & @@ -822,7 +520,6 @@ use material, only: & forall (i=1_pInt:3_pInt, j=1_pInt:3_pInt, k=1_pInt:3_pInt, l=1_pInt:3_pInt) & dT_dFe(i,j,k,l) = math_mul3x3(C(i,j,l,1:3),Fe(k,1:3)) ! dT*_ij/dFe_kl -#ifdef NEWSTATE phase = mappingConstitutive(2,ipc,ip,el) constituent = mappingConstitutive(1,ipc,ip,el) select case (phase_damage(phase)) @@ -842,7 +539,6 @@ use material, only: & lattice_referenceTemperature(phase)) & * lattice_thermalExpansion33(1:3,1:3,phase)) end select -#endif end subroutine constitutive_hooke_TandItsTangent @@ -853,6 +549,7 @@ end subroutine constitutive_hooke_TandItsTangent subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, Temperature, subdt, subfracArray,& ipc, ip, el) use prec, only: & + pReal, & pLongInt use debug, only: & debug_cumDotStateCalls, & @@ -865,10 +562,8 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, Temperature, mesh_maxNips use material, only: & phase_plasticity, & -#ifdef NEWSTATE plasticState, & - mappingConstitutive, & -#endif + mappingConstitutive, & material_phase, & homogenization_maxNgrains, & PLASTICITY_NONE_ID, & @@ -912,59 +607,17 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, Temperature, call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) select case (phase_plasticity(material_phase(ipc,ip,el))) - case (PLASTICITY_NONE_ID) - case (PLASTICITY_J2_ID) -#ifdef NEWSTATE - plasticState(mappingConstitutive(2,ipc,ip,el))%dotState(:,mappingConstitutive(1,ipc,ip,el)) & - = constitutive_j2_dotState(Tstar_v,plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)), ipc,ip,el) -#else - constitutive_dotState(ipc,ip,el)%p = constitutive_j2_dotState(Tstar_v,& - constitutive_state(ipc,ip,el), ipc,ip,el) -#endif + call constitutive_j2_dotState (Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) -#ifdef NEWSTATE - plasticState(mappingConstitutive(2,ipc,ip,el))%dotState(:,mappingConstitutive(1,ipc,ip,el)) & - = constitutive_phenopowerlaw_dotState(Tstar_v,plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)), ipc,ip,el) -#else - constitutive_dotState(ipc,ip,el)%p = constitutive_phenopowerlaw_dotState(Tstar_v,& - constitutive_state(ipc,ip,el), ipc,ip,el) -#endif + call constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) -#ifdef NEWSTATE - plasticState(mappingConstitutive(2,ipc,ip,el))%dotState(:,mappingConstitutive(1,ipc,ip,el)) & - = constitutive_dislotwin_dotState(Tstar_v,Temperature,& - plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)), ipc,ip,el) -#else - constitutive_dotState(ipc,ip,el)%p = constitutive_dislotwin_dotState(Tstar_v,Temperature,& - constitutive_state(ipc,ip,el), ipc,ip,el) -#endif + call constitutive_dislotwin_dotState (Tstar_v,Temperature,ipc,ip,el) case (PLASTICITY_TITANMOD_ID) -#ifdef NEWSTATE - plasticState(mappingConstitutive(2,ipc,ip,el))%dotState(:,mappingConstitutive(1,ipc,ip,el)) & - = constitutive_titanmod_dotState(Tstar_v,Temperature,& - plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)), ipc,ip,el) -#else - constitutive_dotState(ipc,ip,el)%p = constitutive_titanmod_dotState(Tstar_v,Temperature,& - constitutive_state(ipc,ip,el), ipc,ip,el) -#endif + call constitutive_titanmod_dotState (Tstar_v,Temperature,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) -#ifdef NEWSTATE -!* - plasticState(mappingConstitutive(2,ipc,ip,el))%dotState(:,mappingConstitutive(1,ipc,ip,el)) = & - constitutive_nonlocal_dotState(Tstar_v, FeArray, FpArray, & - Temperature, subdt, & - subfracArray, ipc, ip, el) - -#else - constitutive_dotState(ipc,ip,el)%p = constitutive_nonlocal_dotState(Tstar_v, FeArray, FpArray, & - Temperature, constitutive_state, constitutive_state0, subdt, & - subfracArray, ipc, ip, el) -#endif + call constitutive_nonlocal_dotState (Tstar_v,FeArray,FpArray,Temperature, subdt, & + subfracArray,ip,el) end select if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then @@ -984,6 +637,7 @@ end subroutine constitutive_collectDotState !-------------------------------------------------------------------------------------------------- logical function constitutive_collectDeltaState(Tstar_v, ipc, ip, el) use prec, only: & + pReal, & pLongInt use debug, only: & debug_cumDeltaStateCalls, & @@ -1021,17 +675,10 @@ logical function constitutive_collectDeltaState(Tstar_v, ipc, ip, el) case (PLASTICITY_NONLOCAL_ID) constitutive_collectDeltaState = .true. -#ifdef NEWSTATE call constitutive_nonlocal_deltaState(Tstar_v,ip,el) -#else - call constitutive_nonlocal_deltaState(constitutive_deltaState(ipc,ip,el)%p,& - constitutive_state(ipc,ip,el), Tstar_v,ipc,ip,el) -#endif case default constitutive_collectDeltaState = .false. -#ifndef NEWSTATE - constitutive_deltaState(ipc,ip,el)%p = 0.0_pReal !ToDo: needed or will it remain zero anyway? -#endif + end select if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then @@ -1051,14 +698,14 @@ end function constitutive_collectDeltaState !> @brief returns array of constitutive results !-------------------------------------------------------------------------------------------------- function constitutive_postResults(Tstar_v, FeArray, temperature, ipc, ip, el) + use prec, only: & + pReal use mesh, only: & mesh_NcpElems, & mesh_maxNips use material, only: & -#ifdef NEWSTATE plasticState, & mappingConstitutive, & -#endif phase_plasticity, & material_phase, & homogenization_maxNgrains, & @@ -1086,13 +733,8 @@ function constitutive_postResults(Tstar_v, FeArray, temperature, ipc, ip, el) ipc, & !< grain number ip, & !< integration point number el !< element number -#ifndef NEWSTATE real(pReal), dimension(constitutive_sizePostResults(ipc,ip,el)) :: & constitutive_postResults -#else - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & - constitutive_postResults -#endif real(pReal), intent(in) :: & temperature real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & @@ -1103,52 +745,16 @@ function constitutive_postResults(Tstar_v, FeArray, temperature, ipc, ip, el) constitutive_postResults = 0.0_pReal select case (phase_plasticity(material_phase(ipc,ip,el))) - - case (PLASTICITY_NONE_ID) case (PLASTICITY_TITANMOD_ID) -#ifdef NEWSTATE - constitutive_postResults = constitutive_titanmod_postResults(& - plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)),ipc,ip,el) -#else - constitutive_postResults = constitutive_titanmod_postResults(& - constitutive_state(ipc,ip,el),ipc,ip,el) -#endif + constitutive_postResults = constitutive_titanmod_postResults (ipc,ip,el) case (PLASTICITY_J2_ID) -#ifdef NEWSTATE - constitutive_postResults= constitutive_j2_postResults(Tstar_v, & - plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)),ipc,ip,el) -#else - constitutive_postResults = constitutive_j2_postResults(Tstar_v,& - constitutive_state(ipc,ip,el),ipc,ip,el) -#endif + constitutive_postResults= constitutive_j2_postResults (Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) -#ifdef NEWSTATE - constitutive_postResults = constitutive_phenopowerlaw_postResults(Tstar_v,& - plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)),ipc,ip,el) -#else - constitutive_postResults = constitutive_phenopowerlaw_postResults(Tstar_v,& - constitutive_state(ipc,ip,el),ipc,ip,el) -#endif + constitutive_postResults = constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) -#ifdef NEWSTATE - constitutive_postResults = constitutive_dislotwin_postResults(Tstar_v,Temperature,& - plasticState(mappingConstitutive(2,ipc,ip,el))% & - state(:,mappingConstitutive(1,ipc,ip,el)),ipc,ip,el) -#else - constitutive_postResults = constitutive_dislotwin_postResults(Tstar_v,Temperature,& - constitutive_state(ipc,ip,el),ipc,ip,el) -#endif + constitutive_postResults = constitutive_dislotwin_postResults(Tstar_v,Temperature,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) -#ifdef NEWSTATE - constitutive_postResults = constitutive_nonlocal_postResults(Tstar_v, FeArray, & - mappingConstitutive, ipc, ip, el) -#else - constitutive_postResults = constitutive_nonlocal_postResults(Tstar_v, FeArray, & - constitutive_state, constitutive_dotstate(ipc,ip,el), ipc, ip, el) -#endif + constitutive_postResults = constitutive_nonlocal_postResults (Tstar_v,FeArray, ip,el) end select end function constitutive_postResults diff --git a/code/constitutive_damage.f90 b/code/constitutive_damage.f90 index 6d0288e5e..837c62e1c 100644 --- a/code/constitutive_damage.f90 +++ b/code/constitutive_damage.f90 @@ -19,7 +19,6 @@ module constitutive_damage constitutive_damage_init, & constitutive_damage_microstructure, & constitutive_damage_collectDotState, & - constitutive_damage_collectDeltaState, & constitutive_damage_postResults contains @@ -206,28 +205,6 @@ subroutine constitutive_damage_collectDotState(Tstar_v, Lp, ipc, ip, el) end subroutine constitutive_damage_collectDotState -!-------------------------------------------------------------------------------------------------- -!> @brief for constitutive models having an instantaneous change of state (so far, only nonlocal) -!> will return false if delta state is not needed/supported by the constitutive model -!-------------------------------------------------------------------------------------------------- -logical function constitutive_damage_collectDeltaState(ipc, ip, el) - use material, only: & - material_phase, & - phase_damage - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - - select case (phase_damage(material_phase(ipc,ip,el))) - - end select - constitutive_damage_collectDeltaState = .true. - -end function constitutive_damage_collectDeltaState - !-------------------------------------------------------------------------------------------------- !> @brief returns array of constitutive results diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index 3e49accb2..ba41e5546 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -14,9 +14,7 @@ module constitutive_dislotwin implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - constitutive_dislotwin_sizeDotState, & !< number of dotStates - constitutive_dislotwin_sizeState, & !< total number of microstructural state variables - constitutive_dislotwin_sizePostResults !< cumulative size of post results + constitutive_dislotwin_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & constitutive_dislotwin_sizePostResult !< size of each post result output @@ -145,13 +143,14 @@ module constitutive_dislotwin public :: & constitutive_dislotwin_init, & - constitutive_dislotwin_stateInit, & - constitutive_dislotwin_aTolState, & constitutive_dislotwin_homogenizedC, & constitutive_dislotwin_microstructure, & constitutive_dislotwin_LpAndItsTangent, & constitutive_dislotwin_dotState, & constitutive_dislotwin_postResults + private :: & + constitutive_dislotwin_stateInit, & + constitutive_dislotwin_aTolState contains @@ -194,15 +193,11 @@ subroutine constitutive_dislotwin_init(fileUnit) PLASTICITY_DISLOTWIN_label, & PLASTICITY_DISLOTWIN_ID, & material_phase, & -#ifdef NEWSTATE - plasticState, & -#endif + plasticState, & MATERIAL_partPhase use lattice -#ifdef NEWSTATE use numerics,only: & numerics_integrator -#endif implicit none integer(pInt), intent(in) :: fileUnit @@ -214,9 +209,7 @@ subroutine constitutive_dislotwin_init(fileUnit) Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & Nchunks_SlipFamilies, Nchunks_TwinFamilies, & index_myFamily, index_otherFamily -#ifdef NEWSTATE integer(pInt) :: sizeState, sizeDotState -#endif integer(pInt) :: NofMyPhase character(len=65536) :: & tag = '', & @@ -234,8 +227,6 @@ subroutine constitutive_dislotwin_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(constitutive_dislotwin_sizeDotState(maxNinstance), source=0_pInt) - allocate(constitutive_dislotwin_sizeState(maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_sizePostResults(maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) allocate(constitutive_dislotwin_output(maxval(phase_Noutput),maxNinstance)) @@ -330,6 +321,7 @@ subroutine constitutive_dislotwin_init(fileUnit) endif cycle ! skip to next line endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOTWIN_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase positions = IO_stringPos(line,MAXNCHUNKS) @@ -668,21 +660,13 @@ subroutine constitutive_dislotwin_init(fileUnit) allocate(constitutive_dislotwin_Ctwin3333(3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) initializeInstances: do phase = 1_pInt, size(phase_plasticity) - if (phase_plasticity(phase) == PLASTICITY_dislotwin_ID) then + myPhase2: if (phase_plasticity(phase) == PLASTICITY_dislotwin_ID) then NofMyPhase=count(material_phase==phase) instance = phase_plasticityInstance(phase) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) -!-------------------------------------------------------------------------------------------------- -! Determine size of state array - constitutive_dislotwin_sizeDotState(instance) = int(size(CONSTITUTIVE_DISLOTWIN_listBasicSlipStates),pInt) * ns & - + int(size(CONSTITUTIVE_DISLOTWIN_listBasicTwinStates),pInt) * nt - constitutive_dislotwin_sizeState(instance) = constitutive_dislotwin_sizeDotState(instance) & - + int(size(CONSTITUTIVE_DISLOTWIN_listDependentSlipStates),pInt) * ns & - + int(size(CONSTITUTIVE_DISLOTWIN_listDependentTwinStates),pInt) * nt - !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array outputsLoop: do o = 1_pInt,constitutive_dislotwin_Noutput(instance) @@ -721,8 +705,9 @@ subroutine constitutive_dislotwin_init(fileUnit) constitutive_dislotwin_sizePostResults(instance) = constitutive_dislotwin_sizePostResults(instance) + mySize endif enddo outputsLoop -#ifdef NEWSTATE -! Determine size of state array + +!-------------------------------------------------------------------------------------------------- +! allocate state arrays sizeDotState = int(size(CONSTITUTIVE_DISLOTWIN_listBasicSlipStates),pInt) * ns & + int(size(CONSTITUTIVE_DISLOTWIN_listBasicTwinStates),pInt) * nt sizeState = sizeDotState & @@ -749,7 +734,6 @@ subroutine constitutive_dislotwin_init(fileUnit) allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (any(numerics_integrator == 5_pInt)) & allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) -#endif !* Process slip related parameters ------------------------------------------------ slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(constitutive_dislotwin_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list @@ -860,20 +844,18 @@ subroutine constitutive_dislotwin_init(fileUnit) enddo twinSystemsLoop enddo twinFamiliesLoop -#ifdef NEWSTATE + call constitutive_dislotwin_stateInit(phase,instance) call constitutive_dislotwin_aTolState(phase,instance) -#endif - endif + endif myPhase2 enddo initializeInstances end subroutine constitutive_dislotwin_init -#ifdef NEWSTATE !-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant NEW state values for a given instance of this plasticity +!> @brief sets the relevant state values for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -subroutine constitutive_dislotwin_stateInit(phase,instance) +subroutine constitutive_dislotwin_stateInit(ph,instance) use math, only: & pi use lattice, only: & @@ -883,12 +865,14 @@ subroutine constitutive_dislotwin_stateInit(phase,instance) lattice_bcc_ID use material, only: & plasticState - - implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - integer(pInt), intent(in) :: phase !< number specifying the phase of the plasticity - real(pReal), dimension(plasticState(phase)%sizeState) :: tempState + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + + + real(pReal), dimension(plasticState(ph)%sizeState) :: tempState integer(pInt) :: i,j,f,ns,nt, index_myFamily real(pReal), dimension(constitutive_dislotwin_totalNslip(instance)) :: & @@ -932,7 +916,7 @@ subroutine constitutive_dislotwin_stateInit(phase,instance) forall (i = 1_pInt:ns) & tauSlipThreshold0(i) = & - lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(i,instance) * & + lattice_mu(ph)*constitutive_dislotwin_burgersPerSlipSystem(i,instance) * & sqrt(dot_product((rhoEdge0+rhoEdgeDip0),constitutive_dislotwin_interactionMatrix_SlipSlip(i,1:ns,instance))) tempState(6_pInt*ns+4_pInt*nt+1:7_pInt*ns+4_pInt*nt) = tauSlipThreshold0 @@ -950,172 +934,48 @@ subroutine constitutive_dislotwin_stateInit(phase,instance) (pi/4.0_pReal)*constitutive_dislotwin_twinsizePerTwinSystem(j,instance)*MeanFreePathTwin0(j)**(2.0_pReal) tempState(7_pInt*ns+5_pInt*nt+1_pInt:7_pInt*ns+6_pInt*nt) = TwinVolume0 -plasticState(phase)%state = spread(tempState,2,size(plasticState(phase)%state(1,:))) -plasticState(phase)%state0 = plasticState(phase)%state -plasticState(phase)%partionedState0 = plasticState(phase)%state +plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) + end subroutine constitutive_dislotwin_stateInit !-------------------------------------------------------------------------------------------------- !> @brief sets the relevant state values for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -subroutine constitutive_dislotwin_aTolState(phase,instance) +subroutine constitutive_dislotwin_aTolState(ph,instance) use material, only: & plasticState implicit none integer(pInt), intent(in) :: & - phase, & + ph, & instance ! number specifying the current instance of the plasticity -! real(pReal), dimension(size(plasticState(phase)%aTolState(:))) :: tempTol - real(pReal), dimension(plasticState(phase)%sizeState) :: tempTol - - tempTol = 0.0_pReal - + ! Tolerance state for dislocation densities - tempTol(1_pInt:2_pInt*constitutive_dislotwin_totalNslip(instance)) = & + plasticState(ph)%aTolState(1_pInt:2_pInt*constitutive_dislotwin_totalNslip(instance)) = & constitutive_dislotwin_aTolRho(instance) ! Tolerance state for accumulated shear due to slip - tempTol(2_pInt*constitutive_dislotwin_totalNslip(instance)+1_pInt: & + plasticState(ph)%aTolState(2_pInt*constitutive_dislotwin_totalNslip(instance)+1_pInt: & 3_pInt*constitutive_dislotwin_totalNslip(instance))=1e6_pReal ! Tolerance state for twin volume fraction - tempTol(3_pInt*constitutive_dislotwin_totalNslip(instance)+1_pInt: & + plasticState(ph)%aTolState(3_pInt*constitutive_dislotwin_totalNslip(instance)+1_pInt: & 3_pInt*constitutive_dislotwin_totalNslip(instance)+& constitutive_dislotwin_totalNtwin(instance)) = & constitutive_dislotwin_aTolTwinFrac(instance) ! Tolerance state for accumulated shear due to twin - tempTol(3_pInt*constitutive_dislotwin_totalNslip(instance)+ & + plasticState(ph)%aTolState(3_pInt*constitutive_dislotwin_totalNslip(instance)+ & constitutive_dislotwin_totalNtwin(instance)+1_pInt: & 3_pInt*constitutive_dislotwin_totalNslip(instance)+ & 2_pInt*constitutive_dislotwin_totalNtwin(instance)) = 1e6_pReal - plasticState(phase)%aTolState = tempTol + end subroutine constitutive_dislotwin_aTolState - -#else -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -function constitutive_dislotwin_stateInit(instance,phase) - use math, only: & - pi - use lattice, only: & - lattice_maxNslipFamily, & - lattice_structure, & - lattice_mu, & - lattice_bcc_ID - - implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - integer(pInt), intent(in) :: phase !< number specifying the phase of the plasticity - real(pReal), dimension(constitutive_dislotwin_sizeState(instance)) :: & - constitutive_dislotwin_stateInit - - integer(pInt) :: i,j,f,ns,nt, index_myFamily - real(pReal), dimension(constitutive_dislotwin_totalNslip(instance)) :: & - rhoEdge0, & - rhoEdgeDip0, & - invLambdaSlip0, & - MeanFreePathSlip0, & - tauSlipThreshold0 - real(pReal), dimension(constitutive_dislotwin_totalNtwin(instance)) :: & - MeanFreePathTwin0,TwinVolume0 - - ns = constitutive_dislotwin_totalNslip(instance) - nt = constitutive_dislotwin_totalNtwin(instance) - constitutive_dislotwin_stateInit = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables - do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(constitutive_dislotwin_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list - rhoEdge0(index_myFamily+1_pInt: & - index_myFamily+constitutive_dislotwin_Nslip(f,instance)) = & - constitutive_dislotwin_rhoEdge0(f,instance) - rhoEdgeDip0(index_myFamily+1_pInt: & - index_myFamily+constitutive_dislotwin_Nslip(f,instance)) = & - constitutive_dislotwin_rhoEdgeDip0(f,instance) - enddo - - constitutive_dislotwin_stateInit(1_pInt:ns) = rhoEdge0 - constitutive_dislotwin_stateInit(ns+1_pInt:2_pInt*ns) = rhoEdgeDip0 - -!-------------------------------------------------------------------------------------------------- -! initialize dependent slip microstructural variables - forall (i = 1_pInt:ns) & - invLambdaSlip0(i) = sqrt(dot_product((rhoEdge0+rhoEdgeDip0),constitutive_dislotwin_forestProjectionEdge(1:ns,i,instance)))/ & - constitutive_dislotwin_CLambdaSlipPerSlipSystem(i,instance) - constitutive_dislotwin_stateInit(3_pInt*ns+2_pInt*nt+1:4_pInt*ns+2_pInt*nt) = invLambdaSlip0 - - forall (i = 1_pInt:ns) & - MeanFreePathSlip0(i) = & - constitutive_dislotwin_GrainSize(instance)/(1.0_pReal+invLambdaSlip0(i)*constitutive_dislotwin_GrainSize(instance)) - constitutive_dislotwin_stateInit(5_pInt*ns+3_pInt*nt+1:6_pInt*ns+3_pInt*nt) = MeanFreePathSlip0 - - forall (i = 1_pInt:ns) & - tauSlipThreshold0(i) = & - lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(i,instance) * & - sqrt(dot_product((rhoEdge0+rhoEdgeDip0),constitutive_dislotwin_interactionMatrix_SlipSlip(i,1:ns,instance))) - - constitutive_dislotwin_stateInit(6_pInt*ns+4_pInt*nt+1:7_pInt*ns+4_pInt*nt) = tauSlipThreshold0 - - - -!-------------------------------------------------------------------------------------------------- -! initialize dependent twin microstructural variables - forall (j = 1_pInt:nt) & - MeanFreePathTwin0(j) = constitutive_dislotwin_GrainSize(instance) - constitutive_dislotwin_stateInit(6_pInt*ns+3_pInt*nt+1_pInt:6_pInt*ns+4_pInt*nt) = MeanFreePathTwin0 - - forall (j = 1_pInt:nt) & - TwinVolume0(j) = & - (pi/4.0_pReal)*constitutive_dislotwin_twinsizePerTwinSystem(j,instance)*MeanFreePathTwin0(j)**(2.0_pReal) - constitutive_dislotwin_stateInit(7_pInt*ns+5_pInt*nt+1_pInt:7_pInt*ns+6_pInt*nt) = TwinVolume0 - -end function constitutive_dislotwin_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -pure function constitutive_dislotwin_aTolState(instance) - - implicit none - integer(pInt), intent(in) :: & - instance ! number specifying the current instance of the plasticity - real(pReal), dimension(constitutive_dislotwin_sizeState(instance)) :: & - constitutive_dislotwin_aTolState ! relevant state values for the current instance of this plasticity - constitutive_dislotwin_aTolState = 0.0_pReal - ! Tolerance state for dislocation densities - constitutive_dislotwin_aTolState(1_pInt:2_pInt*constitutive_dislotwin_totalNslip(instance)) = & - constitutive_dislotwin_aTolRho(instance) - - ! Tolerance state for accumulated shear due to slip - constitutive_dislotwin_aTolState(2_pInt*constitutive_dislotwin_totalNslip(instance)+1_pInt: & - 3_pInt*constitutive_dislotwin_totalNslip(instance))=1e6_pReal - - - ! Tolerance state for twin volume fraction - constitutive_dislotwin_aTolState(3_pInt*constitutive_dislotwin_totalNslip(instance)+1_pInt: & - 3_pInt*constitutive_dislotwin_totalNslip(instance)+& - constitutive_dislotwin_totalNtwin(instance)) = & - constitutive_dislotwin_aTolTwinFrac(instance) - -! Tolerance state for accumulated shear due to twin - constitutive_dislotwin_aTolState(3_pInt*constitutive_dislotwin_totalNslip(instance)+ & - constitutive_dislotwin_totalNtwin(instance)+1_pInt: & - 3_pInt*constitutive_dislotwin_totalNslip(instance)+ & - 2_pInt*constitutive_dislotwin_totalNtwin(instance)) = 1e6_pReal - -end function constitutive_dislotwin_aTolState -#endif - !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- -pure function constitutive_dislotwin_homogenizedC(state,ipc,ip,el) +function constitutive_dislotwin_homogenizedC(ipc,ip,el) use prec, only: & p_vec use mesh, only: & @@ -1124,7 +984,9 @@ pure function constitutive_dislotwin_homogenizedC(state,ipc,ip,el) use material, only: & homogenization_maxNgrains, & material_phase, & - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive use lattice, only: & lattice_C66 @@ -1135,40 +997,26 @@ pure function constitutive_dislotwin_homogenizedC(state,ipc,ip,el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif - integer(pInt) :: instance,ns,nt,i,phase + + integer(pInt) :: instance,ns,nt,i, & + ph, & + of real(pReal) :: sumf - tempState = 0.0_pReal -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif - + !* Shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) !* Total twin volume fraction - sumf = sum(tempState((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0 + sumf = sum(plasticState(ph)%state((3_pInt*ns+1_pInt):(3_pInt*ns+nt),of)) ! safe for nt == 0 !* Homogenized elasticity matrix - constitutive_dislotwin_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,phase) + constitutive_dislotwin_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,ph) do i=1_pInt,nt constitutive_dislotwin_homogenizedC = & - constitutive_dislotwin_homogenizedC +tempState(3_pInt*ns+i)*lattice_C66(1:6,1:6,phase) + constitutive_dislotwin_homogenizedC + plasticState(ph)%state(3_pInt*ns+i, of)*lattice_C66(1:6,1:6,ph) enddo end function constitutive_dislotwin_homogenizedC @@ -1176,7 +1024,7 @@ pure function constitutive_dislotwin_homogenizedC(state,ipc,ip,el) !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) +subroutine constitutive_dislotwin_microstructure(temperature,ipc,ip,el) use prec, only: & p_vec use math, only: & @@ -1187,7 +1035,9 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) use material, only: & homogenization_maxNgrains, & material_phase, & - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive use lattice, only: & lattice_structure, & lattice_mu, & @@ -1203,32 +1053,20 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) el !< element real(pReal), intent(in) :: & temperature !< temperature at IP -#ifdef NEWSTATE - real(pReal), dimension(:), intent(inout) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(inout) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif + integer(pInt) :: & - instance,phase,& - ns,nt,s,t + instance, & + ns,nt,s,t, & + ph, & + of real(pReal) :: & sumf,sfe,x0 real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: fOverStacksize - tempState = 0.0_pReal -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif + !* Shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) !* State: 1 : ns rho_edge @@ -1246,7 +1084,7 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) !* State: 7*ns+5*nt+1 : 7*ns+6*nt twin volume !* Total twin volume fraction - sumf = sum(tempState((3*ns+1):(3*ns+nt))) ! safe for nt == 0 + sumf = sum(plasticState(ph)%state((3*ns+1):(3*ns+nt), of)) ! safe for nt == 0 !* Stacking fault energy sfe = constitutive_dislotwin_SFE_0K(instance) + & @@ -1255,88 +1093,84 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) !* rescaled twin volume fraction for topology forall (t = 1_pInt:nt) & fOverStacksize(t) = & - tempState(3_pInt*ns+t)/constitutive_dislotwin_twinsizePerTwinSystem(t,instance) + plasticState(ph)%state(3_pInt*ns+t, of)/constitutive_dislotwin_twinsizePerTwinSystem(t,instance) !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation forall (s = 1_pInt:ns) & - tempState(3_pInt*ns+2_pInt*nt+s) = & - sqrt(dot_product((tempState(1:ns)+tempState(ns+1_pInt:2_pInt*ns)),& + plasticState(ph)%state(3_pInt*ns+2_pInt*nt+s, of) = & + sqrt(dot_product((plasticState(ph)%state(1:ns,of)+plasticState(ph)%state(ns+1_pInt:2_pInt*ns,of)),& constitutive_dislotwin_forestProjectionEdge(1:ns,s,instance)))/ & constitutive_dislotwin_CLambdaSlipPerSlipSystem(s,instance) !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation !$OMP CRITICAL (evilmatmul) - tempState((4_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+2_pInt*nt)) = 0.0_pReal + plasticState(ph)%state((4_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+2_pInt*nt), of) = 0.0_pReal if (nt > 0_pInt .and. ns > 0_pInt) & - tempState((4_pInt*ns+2_pInt*nt+1):(5_pInt*ns+2_pInt*nt)) = & + plasticState(ph)%state((4_pInt*ns+2_pInt*nt+1):(5_pInt*ns+2_pInt*nt), of) = & matmul(constitutive_dislotwin_interactionMatrix_SlipTwin(1:ns,1:nt,instance),fOverStacksize(1:nt))/(1.0_pReal-sumf) !$OMP END CRITICAL (evilmatmul) !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin !$OMP CRITICAL (evilmatmul) if (nt > 0_pInt) & - tempState((5_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+3_pInt*nt)) = & + plasticState(ph)%state((5_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+3_pInt*nt), of) = & matmul(constitutive_dislotwin_interactionMatrix_TwinTwin(1:nt,1:nt,instance),fOverStacksize(1:nt))/(1.0_pReal-sumf) !$OMP END CRITICAL (evilmatmul) !* mean free path between 2 obstacles seen by a moving dislocation do s = 1_pInt,ns if (nt > 0_pInt) then - tempState(5_pInt*ns+3_pInt*nt+s) = & + plasticState(ph)%state(5_pInt*ns+3_pInt*nt+s, of) = & constitutive_dislotwin_GrainSize(instance)/(1.0_pReal+constitutive_dislotwin_GrainSize(instance)*& - (tempState(3_pInt*ns+2_pInt*nt+s)+tempState(4_pInt*ns+2_pInt*nt+s))) + (plasticState(ph)%state(3_pInt*ns+2_pInt*nt+s, of)+plasticState(ph)%state(4_pInt*ns+2_pInt*nt+s, of))) else - tempState(5_pInt*ns+s) = & + plasticState(ph)%state(5_pInt*ns+s, of) = & constitutive_dislotwin_GrainSize(instance)/& - (1.0_pReal+constitutive_dislotwin_GrainSize(instance)*(tempState(3_pInt*ns+s))) + (1.0_pReal+constitutive_dislotwin_GrainSize(instance)*(plasticState(ph)%state(3_pInt*ns+s, of))) endif enddo !* mean free path between 2 obstacles seen by a growing twin forall (t = 1_pInt:nt) & - tempState(6_pInt*ns+3_pInt*nt+t) = & + plasticState(ph)%state(6_pInt*ns+3_pInt*nt+t, of) = & (constitutive_dislotwin_Cmfptwin(instance)*constitutive_dislotwin_GrainSize(instance))/& - (1.0_pReal+constitutive_dislotwin_GrainSize(instance)*tempState(5_pInt*ns+2_pInt*nt+t)) + (1.0_pReal+constitutive_dislotwin_GrainSize(instance)*plasticState(ph)%state(5_pInt*ns+2_pInt*nt+t, of)) !* threshold stress for dislocation motion forall (s = 1_pInt:ns) & - tempState(6_pInt*ns+4_pInt*nt+s) = & - lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(s,instance)*& - sqrt(dot_product((tempState(1:ns)+tempState(ns+1_pInt:2_pInt*ns)),& + plasticState(ph)%state(6_pInt*ns+4_pInt*nt+s, of) = & + lattice_mu(ph)*constitutive_dislotwin_burgersPerSlipSystem(s,instance)*& + sqrt(dot_product((plasticState(ph)%state(1:ns, of)+plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& constitutive_dislotwin_interactionMatrix_SlipSlip(s,1:ns,instance))) !* threshold stress for growing twin forall (t = 1_pInt:nt) & - tempState(7_pInt*ns+4_pInt*nt+t) = & + plasticState(ph)%state(7_pInt*ns+4_pInt*nt+t, of) = & constitutive_dislotwin_Cthresholdtwin(instance)*& (sfe/(3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,instance))+& - 3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,instance)*lattice_mu(phase)/& + 3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,instance)*lattice_mu(ph)/& (constitutive_dislotwin_L0(instance)*constitutive_dislotwin_burgersPerSlipSystem(t,instance))) !* final twin volume after growth forall (t = 1_pInt:nt) & - tempState(7_pInt*ns+5_pInt*nt+t) = & - (pi/4.0_pReal)*constitutive_dislotwin_twinsizePerTwinSystem(t,instance)*tempState(6*ns+3*nt+t)**(2.0_pReal) + plasticState(ph)%state(7_pInt*ns+5_pInt*nt+t, of) = & + (pi/4.0_pReal)*constitutive_dislotwin_twinsizePerTwinSystem(t,instance)*plasticState(ph)%state(6*ns+3*nt+t, of)**(2.0_pReal) !* equilibrium seperation of partial dislocations do t = 1_pInt,nt - x0 = lattice_mu(phase)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)**(2.0_pReal)/& - (sfe*8.0_pReal*pi)*(2.0_pReal+lattice_nu(phase))/(1.0_pReal-lattice_nu(phase)) + x0 = lattice_mu(ph)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)**(2.0_pReal)/& + (sfe*8.0_pReal*pi)*(2.0_pReal+lattice_nu(ph))/(1.0_pReal-lattice_nu(ph)) constitutive_dislotwin_tau_r(t,instance)= & - lattice_mu(phase)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)/(2.0_pReal*pi)*& - (1/(x0+constitutive_dislotwin_xc(instance))+cos(pi/3.0_pReal)/x0) + lattice_mu(ph)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)/(2.0_pReal*pi)*& + (1/(x0+constitutive_dislotwin_xc(instance))+cos(pi/3.0_pReal)/x0) !!! used where?? enddo -#ifdef NEWSTATE - state=tempState -#else - state%p = tempState -#endif + end subroutine constitutive_dislotwin_microstructure !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,state,ipc,ip,el) +subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,ipc,ip,el) use prec, only: & p_vec, & tol_math_check @@ -1354,7 +1188,9 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat use material, only: & homogenization_maxNgrains, & material_phase, & - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive use lattice, only: & lattice_Sslip, & lattice_Sslip_v, & @@ -1373,21 +1209,10 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat integer(pInt), intent(in) :: ipc,ip,el real(pReal), intent(in) :: Temperature real(pReal), dimension(6), intent(in) :: Tstar_v -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(9,9), intent(out) :: dLp_dTstar - integer(pInt) :: instance,phase,ns,nt,f,i,j,k,l,m,n,index_myFamily,s1,s2 + integer(pInt) :: instance,ph,of,ns,nt,f,i,j,k,l,m,n,index_myFamily,s1,s2 real(pReal) :: sumf,StressRatio_p,StressRatio_pminus1,StressRatio_r,BoltzmannRatio,DotGamma0,Ndot0 real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & @@ -1416,22 +1241,16 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat 0, 1,-1, & 0, 1, 1 & ],pReal),[ 3,6]) - logical error - tempState = 0.0_pReal + logical error !* Shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif - !* Total twin volume fraction - sumf = sum(tempState((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0 + sumf = sum(plasticState(ph)%state((3_pInt*ns+1_pInt):(3_pInt*ns+nt), of)) ! safe for nt == 0 Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal @@ -1442,27 +1261,27 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat dgdot_dtauslip = 0.0_pReal j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystemsLoop: do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) - if((abs(tau_slip(j))-tempState(6*ns+4*nt+j)) > tol_math_check) then + if((abs(tau_slip(j))-plasticState(ph)%state(6*ns+4*nt+j, of)) > tol_math_check) then !* Stress ratios - StressRatio_p = ((abs(tau_slip(j))-tempState(6*ns+4*nt+j))/& + StressRatio_p = ((abs(tau_slip(j))- plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **constitutive_dislotwin_pPerSlipFamily(f,instance) - StressRatio_pminus1 = ((abs(tau_slip(j))-tempState(6*ns+4*nt+j))/& + StressRatio_pminus1 = ((abs(tau_slip(j))-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **(constitutive_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) !* Boltzmann ratio BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) !* Initial shear rates DotGamma0 = & - tempState(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)*& + plasticState(ph)%state(j, of)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)*& constitutive_dislotwin_v0PerSlipSystem(j,instance) !* Shear rates due to slip @@ -1479,14 +1298,14 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat endif !* Plastic velocity gradient for dislocation glide - Lp = Lp + gdot_slip(j)*lattice_Sslip(:,:,1,index_myFamily+i,phase) + Lp = Lp + gdot_slip(j)*lattice_Sslip(:,:,1,index_myFamily+i,ph) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtauslip(j)*& - lattice_Sslip(k,l,1,index_myFamily+i,phase)*& - lattice_Sslip(m,n,1,index_myFamily+i,phase) + lattice_Sslip(k,l,1,index_myFamily+i,ph)*& + lattice_Sslip(m,n,1,index_myFamily+i,ph) enddo slipSystemsLoop enddo slipFamiliesLoop @@ -1550,26 +1369,26 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat dgdot_dtautwin = 0.0_pReal j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystemsLoop: do i = 1_pInt,constitutive_dislotwin_Ntwin(f,instance) j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) !* Stress ratios if (tau_twin(j) > tol_math_check) then - StressRatio_r = (tempState(7*ns+4*nt+j)/tau_twin(j))**constitutive_dislotwin_rPerTwinFamily(f,instance) + StressRatio_r = (plasticState(ph)%state(7*ns+4*nt+j, of)/tau_twin(j))**constitutive_dislotwin_rPerTwinFamily(f,instance) !* Shear rates and their derivatives due to twin - select case(lattice_structure(phase)) + select case(lattice_structure(ph)) case (LATTICE_fcc_ID) s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) if (tau_twin(j) < constitutive_dislotwin_tau_r(j,instance)) then - Ndot0=(abs(gdot_slip(s1))*(tempState(s2)+tempState(ns+s2))+& - abs(gdot_slip(s2))*(tempState(s1)+tempState(ns+s1)))/& + Ndot0=(abs(gdot_slip(s1))*(plasticState(ph)%state(s2,of)+plasticState(ph)%state(ns+s2, of))+& + abs(gdot_slip(s2))*(plasticState(ph)%state(s1, of)+plasticState(ph)%state(ns+s1, of)))/& (constitutive_dislotwin_L0(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))*& (1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& (constitutive_dislotwin_tau_r(j,instance)-tau_twin(j)))) @@ -1580,20 +1399,20 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,instance) end select gdot_twin(j) = & - (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,phase)*& - tempState(7*ns+5*nt+j)*Ndot0*exp(-StressRatio_r) + (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& + plasticState(ph)%state(7*ns+5*nt+j, of)*Ndot0*exp(-StressRatio_r) dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_dislotwin_rPerTwinFamily(f,instance))/tau_twin(j))*StressRatio_r endif !* Plastic velocity gradient for mechanical twinning - Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,phase) + Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin(j)*& - lattice_Stwin(k,l,index_myFamily+i,phase)*& - lattice_Stwin(m,n,index_myFamily+i,phase) + lattice_Stwin(k,l,index_myFamily+i,ph)*& + lattice_Stwin(m,n,index_myFamily+i,ph) enddo twinSystemsLoop enddo twinFamiliesLoop @@ -1605,7 +1424,7 @@ end subroutine constitutive_dislotwin_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,el) +subroutine constitutive_dislotwin_dotState(Tstar_v,Temperature,ipc,ip,el) use prec, only: & p_vec, & tol_math_check @@ -1617,7 +1436,9 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e use material, only: & homogenization_maxNgrains, & material_phase, & - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & @@ -1641,22 +1462,10 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - tempState - real(pReal), dimension(size(state)) :: & - constitutive_dislotwin_dotState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState - real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - constitutive_dislotwin_dotState -#endif - integer(pInt) :: instance,phase,ns,nt,f,i,j,index_myFamily,s1,s2 + + integer(pInt) :: instance,ns,nt,f,i,j,index_myFamily,s1,s2, & + ph, & + of real(pReal) :: sumf,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,& EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,StressRatio_r,Ndot0 real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & @@ -1664,48 +1473,45 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e ClimbVelocity,DotRhoEdgeDipClimb,DotRhoDipFormation real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & tau_twin - tempState = 0.0_pReal -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif !* Shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) - + +! allocate(constitutive_dislotwin_dotState(plasticState(ph)%sizeDotState)) !* Total twin volume fraction - sumf = sum(tempState((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0 - constitutive_dislotwin_dotState = 0.0_pReal + sumf = sum(plasticState(ph)%state((3_pInt*ns+1_pInt):(3_pInt*ns+nt), of)) ! safe for nt == 0 + plasticState(ph)%dotState(:,of) = 0.0_pReal !* Dislocation density evolution gdot_slip = 0.0_pReal j = 0_pInt do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) - if((abs(tau_slip(j))-tempState(6*ns+4*nt+j)) > tol_math_check) then + if((abs(tau_slip(j))-plasticState(ph)%state(6*ns+4*nt+j, of)) > tol_math_check) then !* Stress ratios - StressRatio_p = ((abs(tau_slip(j))-tempState(6*ns+4*nt+j))/& + StressRatio_p = ((abs(tau_slip(j))-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **constitutive_dislotwin_pPerSlipFamily(f,instance) - StressRatio_pminus1 = ((abs(tau_slip(j))-tempState(6*ns+4*nt+j))/& + StressRatio_pminus1 = ((abs(tau_slip(j))-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **(constitutive_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) !* Boltzmann ratio BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) !* Initial shear rates DotGamma0 = & - tempState(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)*& + plasticState(ph)%state(j, of)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)*& constitutive_dislotwin_v0PerSlipSystem(j,instance) !* Shear rates due to slip @@ -1714,7 +1520,8 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e endif !* Multiplication DotRhoMultiplication(j) = abs(gdot_slip(j))/& - (constitutive_dislotwin_burgersPerSlipSystem(j,instance)*tempState(5*ns+3*nt+j)) + (constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & + plasticState(ph)%state(5*ns+3*nt+j, of)) !* Dipole formation EdgeDipMinDistance = & constitutive_dislotwin_CEdgeDipMinDistance(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance) @@ -1722,24 +1529,24 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e DotRhoDipFormation(j) = 0.0_pReal else EdgeDipDistance(j) = & - (3.0_pReal*lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))/& + (3.0_pReal*lattice_mu(ph)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))/& (16.0_pReal*pi*abs(tau_slip(j))) - if (EdgeDipDistance(j)>tempState(5*ns+3*nt+j)) EdgeDipDistance(j)=tempState(5*ns+3*nt+j) + if (EdgeDipDistance(j)>plasticState(ph)%state(5*ns+3*nt+j, of)) EdgeDipDistance(j)=plasticState(ph)%state(5*ns+3*nt+j, of) if (EdgeDipDistance(j) tol_math_check) then - StressRatio_r = (tempState(7*ns+4*nt+j)/tau_twin(j))**constitutive_dislotwin_rPerTwinFamily(f,instance) + StressRatio_r = (plasticState(ph)%state(7*ns+4*nt+j, of)/tau_twin(j))**constitutive_dislotwin_rPerTwinFamily(f,instance) !* Shear rates and their derivatives due to twin - select case(lattice_structure(phase)) + select case(lattice_structure(ph)) case (LATTICE_fcc_ID) s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) if (tau_twin(j) < constitutive_dislotwin_tau_r(j,instance)) then - Ndot0=(abs(gdot_slip(s1))*(tempState(s2)+tempState(ns+s2))+& - abs(gdot_slip(s2))*(tempState(s1)+tempState(ns+s1)))/& + Ndot0=(abs(gdot_slip(s1))*(plasticState(ph)%state(s2, of)+plasticState(ph)%state(ns+s2, of))+& + abs(gdot_slip(s2))*(plasticState(ph)%state(s1, of)+plasticState(ph)%state(ns+s1, of)))/& (constitutive_dislotwin_L0(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))*& (1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& (constitutive_dislotwin_tau_r(j,instance)-tau_twin(j)))) @@ -1800,23 +1607,23 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e case default Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,instance) end select - constitutive_dislotwin_dotState(3_pInt*ns+j) = & + plasticState(ph)%dotState(3_pInt*ns+j, of) = & (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*& - tempState(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r) + plasticState(ph)%state(7_pInt*ns+5_pInt*nt+j, of)*Ndot0*exp(-StressRatio_r) !* Dotstate for accumulated shear due to twin - constitutive_dislotwin_dotState(3_pInt*ns+nt+j) = constitutive_dislotwin_dotState(3_pInt*ns+j) * & - lattice_sheartwin(index_myfamily+i,phase) + plasticState(ph)%dotState(3_pInt*ns+nt+j, of) = plasticState(ph)%dotState(3_pInt*ns+j, of) * & + lattice_sheartwin(index_myfamily+i,ph) endif enddo enddo -end function constitutive_dislotwin_dotState +end subroutine constitutive_dislotwin_dotState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) +function constitutive_dislotwin_postResults(Tstar_v,Temperature,ipc,ip,el) use prec, only: & p_vec, & tol_math_check @@ -1831,7 +1638,9 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) homogenization_maxNgrains,& material_phase, & phase_plasticityInstance,& - phase_Noutput + phase_Noutput, & + plasticState, & + mappingConstitutive use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & @@ -1854,47 +1663,34 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif + real(pReal), dimension(constitutive_dislotwin_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & constitutive_dislotwin_postResults - integer(pInt) :: & instance,phase,& ns,nt,& f,o,i,c,j,index_myFamily,& - s1,s2 + s1,s2, & + ph, & + of real(pReal) :: sumf,tau,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,StressRatio_r,Ndot0,dgdot_dtauslip real(preal), dimension(constitutive_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip real(pReal), dimension(3,3) :: eigVectors real(pReal), dimension (3) :: eigValues logical :: error - tempState = 0.0_pReal -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif + !* Shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) !* Total twin volume fraction - sumf = sum(tempState((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0 + sumf = sum(plasticState(ph)%state((3_pInt*ns+1_pInt):(3_pInt*ns+nt), of)) ! safe for nt == 0 !* Required output c = 0_pInt @@ -1907,28 +1703,28 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) select case(constitutive_dislotwin_outputID(o,instance)) case (edge_density_ID) - constitutive_dislotwin_postResults(c+1_pInt:c+ns) = tempState(1_pInt:ns) + constitutive_dislotwin_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(1_pInt:ns, of) c = c + ns case (dipole_density_ID) - constitutive_dislotwin_postResults(c+1_pInt:c+ns) = tempState(ns+1_pInt:2_pInt*ns) + constitutive_dislotwin_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of) c = c + ns case (shear_rate_slip_ID) j = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt !* Resolved shear stress on slip system - tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) !* Stress ratios - if((abs(tau)-tempState(6*ns+4*nt+j)) > tol_math_check) then + if((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of)) > tol_math_check) then !* Stress ratios - StressRatio_p = ((abs(tau)-tempState(6*ns+4*nt+j))/& + StressRatio_p = ((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+& constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **constitutive_dislotwin_pPerSlipFamily(f,instance) - StressRatio_pminus1 = ((abs(tau)-tempState(6*ns+4*nt+j))/& + StressRatio_pminus1 = ((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+& constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **(constitutive_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) @@ -1936,7 +1732,7 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) !* Initial shear rates DotGamma0 = & - tempState(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & + plasticState(ph)%state(j, of)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & constitutive_dislotwin_v0PerSlipSystem(j,instance) !* Shear rates due to slip @@ -1951,46 +1747,49 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) c = c + ns case (accumulated_shear_slip_ID) constitutive_dislotwin_postResults(c+1_pInt:c+ns) = & - tempState((2_pInt*ns+1_pInt):(3_pInt*ns)) + plasticState(ph)%state((2_pInt*ns+1_pInt):(3_pInt*ns), of) c = c + ns case (mfp_slip_ID) constitutive_dislotwin_postResults(c+1_pInt:c+ns) =& - tempState((5_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+3_pInt*nt)) + plasticState(ph)%state((5_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+3_pInt*nt), of) c = c + ns case (resolved_stress_slip_ID) j = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt constitutive_dislotwin_postResults(c+j) =& - dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) enddo; enddo c = c + ns case (threshold_stress_slip_ID) constitutive_dislotwin_postResults(c+1_pInt:c+ns) = & - tempState((6_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+4_pInt*nt)) + plasticState(ph)%state((6_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+4_pInt*nt), of) c = c + ns case (edge_dipole_distance_ID) j = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt constitutive_dislotwin_postResults(c+j) = & - (3.0_pReal*lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))/& - (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)))) - constitutive_dislotwin_postResults(c+j)=min(constitutive_dislotwin_postResults(c+j),tempState(5*ns+3*nt+j)) - ! constitutive_dislotwin_postResults(c+j)=max(constitutive_dislotwin_postResults(c+j),tempState(4*ns+2*nt+j)) + (3.0_pReal*lattice_mu(ph)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))/& + (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) + constitutive_dislotwin_postResults(c+j)=min(constitutive_dislotwin_postResults(c+j),& + plasticState(ph)%state(5*ns+3*nt+j, of)) + ! constitutive_dislotwin_postResults(c+j)=max(constitutive_dislotwin_postResults(c+j),& + ! plasticState(ph)%state(4*ns+2*nt+j, of)) enddo; enddo c = c + ns case (resolved_stress_shearband_ID) - do j = 1_pInt,6_pInt ! loop over all shearband families - constitutive_dislotwin_postResults(c+j) = dot_product(Tstar_v, constitutive_dislotwin_sbSv(1:6,j,ipc,ip,el)) + do j = 1_pInt,6_pInt ! loop over all shearband families + constitutive_dislotwin_postResults(c+j) = dot_product(Tstar_v, & + constitutive_dislotwin_sbSv(1:6,j,ipc,ip,el)) enddo c = c + 6_pInt case (shear_rate_shearband_ID) - do j = 1_pInt,6_pInt ! loop over all shearbands + do j = 1_pInt,6_pInt ! loop over all shearbands !* Resolved shear stress on shearband system tau = dot_product(Tstar_v,constitutive_dislotwin_sbSv(1:6,j,ipc,ip,el)) !* Stress ratios @@ -2014,27 +1813,27 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) enddo c = c + 6_pInt case (twin_fraction_ID) - constitutive_dislotwin_postResults(c+1_pInt:c+nt) = tempState((3_pInt*ns+1_pInt):(3_pInt*ns+nt)) + constitutive_dislotwin_postResults(c+1_pInt:c+nt) = plasticState(ph)%state((3_pInt*ns+1_pInt):(3_pInt*ns+nt), of) c = c + nt case (shear_rate_twin_ID) if (nt > 0_pInt) then j = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt !* Resolved shear stress on slip system - tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) !* Stress ratios - if((abs(tau)-tempState(6*ns+4*nt+j)) > tol_math_check) then + if((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of)) > tol_math_check) then !* Stress ratios - StressRatio_p = ((abs(tau)-tempState(6*ns+4*nt+j))/& + StressRatio_p = ((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+& constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **constitutive_dislotwin_pPerSlipFamily(f,instance) - StressRatio_pminus1 = ((abs(tau)-tempState(6*ns+4*nt+j))/& + StressRatio_pminus1 = ((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+& constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **(constitutive_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) @@ -2042,7 +1841,7 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) !* Initial shear rates DotGamma0 = & - tempState(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & + plasticState(ph)%state(j, of)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & constitutive_dislotwin_v0PerSlipSystem(j,instance) !* Shear rates due to slip @@ -2054,25 +1853,26 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) enddo;enddo j = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily ! loop over all twin families - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1,constitutive_dislotwin_Ntwin(f,instance) ! process each (active) twin system in family + do f = 1_pInt,lattice_maxNtwinFamily ! loop over all twin families + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1,constitutive_dislotwin_Ntwin(f,instance) ! process each (active) twin system in family j = j + 1_pInt !* Resolved shear stress on twin system - tau = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) + tau = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) !* Stress ratios - StressRatio_r = (tempState(7_pInt*ns+4_pInt*nt+j)/tau)**constitutive_dislotwin_rPerTwinFamily(f,instance) + StressRatio_r = (plasticState(ph)%state(7_pInt*ns+4_pInt*nt+j, of)/ & + tau)**constitutive_dislotwin_rPerTwinFamily(f,instance) !* Shear rates due to twin if ( tau > 0.0_pReal ) then - select case(lattice_structure(phase)) + select case(lattice_structure(ph)) case (LATTICE_fcc_ID) s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) if (tau < constitutive_dislotwin_tau_r(j,instance)) then - Ndot0=(abs(gdot_slip(s1))*(tempState(s2)+tempState(ns+s2))+& - abs(gdot_slip(s2))*(tempState(s1)+tempState(ns+s1)))/& + Ndot0=(abs(gdot_slip(s1))*(plasticState(ph)%state(s2, of)+plasticState(ph)%state(ns+s2, of))+& + abs(gdot_slip(s2))*(plasticState(ph)%state(s1, of)+plasticState(ph)%state(ns+s1, of)))/& (constitutive_dislotwin_L0(instance)*& constitutive_dislotwin_burgersPerSlipSystem(j,instance))*& (1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& @@ -2084,49 +1884,52 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,instance) end select constitutive_dislotwin_postResults(c+j) = & - (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,phase)*& - tempState(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r) + (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& + plasticState(ph)%state(7_pInt*ns+5_pInt*nt+j, of)*Ndot0*exp(-StressRatio_r) endif enddo ; enddo endif c = c + nt case (accumulated_shear_twin_ID) - constitutive_dislotwin_postResults(c+1_pInt:c+nt) = tempState((3_pInt*ns+nt+1_pInt):(3_pInt*ns+2_pInt*nt)) + constitutive_dislotwin_postResults(c+1_pInt:c+nt) = plasticState(ph)% & + state((3_pInt*ns+nt+1_pInt) :(3_pInt*ns+2_pInt*nt), of) c = c + nt case (mfp_twin_ID) - constitutive_dislotwin_postResults(c+1_pInt:c+nt) = tempState((6_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+4_pInt*nt)) + constitutive_dislotwin_postResults(c+1_pInt:c+nt) = plasticState(ph)% & + state((6_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+4_pInt*nt), of) c = c + nt case (resolved_stress_twin_ID) if (nt > 0_pInt) then j = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily ! loop over all slip families - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Ntwin(f,instance) ! process each (active) slip system in family + do f = 1_pInt,lattice_maxNtwinFamily ! loop over all slip families + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Ntwin(f,instance) ! process each (active) slip system in family j = j + 1_pInt - constitutive_dislotwin_postResults(c+j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) + constitutive_dislotwin_postResults(c+j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) enddo; enddo endif c = c + nt case (threshold_stress_twin_ID) - constitutive_dislotwin_postResults(c+1_pInt:c+nt) = tempState((7_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+5_pInt*nt)) + constitutive_dislotwin_postResults(c+1_pInt:c+nt) = plasticState(ph)% & + state((7_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+5_pInt*nt), of) c = c + nt case (stress_exponent_ID) j = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt !* Resolved shear stress on slip system - tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) - if((abs(tau)-tempState(6*ns+4*nt+j)) > tol_math_check) then + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + if((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of)) > tol_math_check) then !* Stress ratios - StressRatio_p = ((abs(tau)-tempState(6*ns+4*nt+j))/& + StressRatio_p = ((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+& constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **constitutive_dislotwin_pPerSlipFamily(f,instance) - StressRatio_pminus1 = ((abs(tau)-tempState(6*ns+4*nt+j))/& + StressRatio_pminus1 = ((abs(tau)-plasticState(ph)%state(6*ns+4*nt+j, of))/& (constitutive_dislotwin_SolidSolutionStrength(instance)+& constitutive_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& **(constitutive_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) @@ -2134,7 +1937,7 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) !* Initial shear rates DotGamma0 = & - tempState(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & + plasticState(ph)%state(j, of)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & constitutive_dislotwin_v0PerSlipSystem(j,instance) !* Shear rates due to slip diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index bb491f970..d713e0fce 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -13,6 +13,7 @@ module constitutive_j2 use hdf5, only: & HID_T #endif + use prec, only: & pReal,& pInt @@ -20,10 +21,6 @@ module constitutive_j2 implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & -#ifndef NEWSTATE - constitutive_j2_sizeDotState, & !< number of dotStates - constitutive_j2_sizeState, & !< total number of microstructural variables -#endif constitutive_j2_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -58,25 +55,24 @@ module constitutive_j2 flowstress_ID, & strainrate_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & constitutive_j2_outputID !< ID of each post result output + #ifdef HDF type constitutive_j2_tOutput real(pReal), dimension(:), allocatable, private :: & flowstress, & strainrate - logical :: flowstressActive = .false., strainrateActive = .false. ! if we can write the output block wise, this is not needed anymore because we can do an if(allocated(xxx)) + logical :: flowstressActive = .false., strainrateActive = .false. ! if we can write the output block wise, this is not needed anymore because we can do an if(allocated(xxx)) end type constitutive_j2_tOutput type(constitutive_j2_tOutput), allocatable, dimension(:) :: constitutive_j2_Output2 integer(HID_T), allocatable, dimension(:) :: outID -#endif +#endif + + public :: & constitutive_j2_init, & -#ifndef NEWSTATE - constitutive_j2_stateInit, & - constitutive_j2_aTolState, & -#endif constitutive_j2_LpAndItsTangent, & constitutive_j2_dotState, & constitutive_j2_postResults @@ -126,9 +122,7 @@ subroutine constitutive_j2_init(fileUnit) PLASTICITY_J2_label, & PLASTICITY_J2_ID, & material_phase, & -#ifdef NEWSTATE plasticState, & -#endif MATERIAL_partPhase use lattice @@ -139,19 +133,25 @@ subroutine constitutive_j2_init(fileUnit) integer(pInt), parameter :: MAXNCHUNKS = 7_pInt integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions - integer(pInt) :: phase, maxNinstance, instance,o, mySize, myConstituents + integer(pInt) :: & + o, & + phase, & + maxNinstance, & + instance, & + mySize, & + sizeDotState, & + sizeState character(len=65536) :: & tag = '', & line = '' integer(pInt) :: NofMyPhase + #ifdef HDF character(len=5) :: & str1 integer(HID_T) :: ID,ID2,ID4 #endif -#ifdef NEWSTATE - integer(pInt) :: sizeDotState,sizeState -#endif + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_J2_label//' init -+>>>' write(6,'(a)') ' $Id$' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -160,17 +160,14 @@ subroutine constitutive_j2_init(fileUnit) maxNinstance = int(count(phase_plasticity == PLASTICITY_J2_ID),pInt) if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + #ifdef HDF allocate(constitutive_j2_Output2(maxNinstance)) allocate(outID(maxNinstance)) #endif - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance -#ifndef NEWSTATE - allocate(constitutive_j2_sizeDotState(maxNinstance), source=1_pInt) - allocate(constitutive_j2_sizeState(maxNinstance), source=1_pInt) -#endif allocate(constitutive_j2_sizePostResults(maxNinstance), source=0_pInt) allocate(constitutive_j2_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt) allocate(constitutive_j2_output(maxval(phase_Noutput), maxNinstance)) @@ -205,18 +202,16 @@ subroutine constitutive_j2_init(fileUnit) exit endif if (IO_getTag(line,'[',']') /= '') then ! next section - myConstituents = 0_pInt phase = phase + 1_pInt ! advance section counter if (phase_plasticity(phase) == PLASTICITY_J2_ID) then instance = phase_plasticityInstance(phase) - myConstituents = count(material_phase==phase) #ifdef HDF outID(instance)=HDF5_addGroup(str1,tempResults) #endif endif cycle ! skip to next line endif - if (myConstituents > 0_pInt ) then + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_J2_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase positions = IO_stringPos(line,MAXNCHUNKS) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key @@ -290,13 +285,15 @@ subroutine constitutive_j2_init(fileUnit) case default end select - endif + endif; endif enddo parsingFile initializeInstances: do phase = 1_pInt, size(phase_plasticity) - NofMyPhase=count(material_phase==phase) - if (phase_plasticity(phase) == PLASTICITY_j2_ID .and. NofMyPhase/=0) then + myPhase: if (phase_plasticity(phase) == PLASTICITY_j2_ID) then + NofMyPhase=count(material_phase==phase) instance = phase_plasticityInstance(phase) +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array outputsLoop: do o = 1_pInt,constitutive_j2_Noutput(instance) select case(constitutive_j2_outputID(o,instance)) case(flowstress_ID,strainrate_ID) @@ -310,75 +307,41 @@ subroutine constitutive_j2_init(fileUnit) constitutive_j2_sizePostResults(instance) + mySize endif enddo outputsLoop -#ifdef NEWSTATE - sizeState = 1 + +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + sizeState = 1_pInt plasticState(phase)%sizeState = sizeState sizeDotState = sizeState plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizePostResults = constitutive_j2_sizePostResults(instance) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase),source=constitutive_j2_tau0(instance)) - allocate(plasticState(phase)%partionedState0(sizeState,NofMyPhase),source=constitutive_j2_tau0(instance)) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%state (sizeState,NofMyPhase),source=constitutive_j2_tau0(instance)) - allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%aTolState (NofMyPhase),source=constitutive_j2_aTolResistance(instance)) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%aTolState (sizeState),source=constitutive_j2_aTolResistance(instance)) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase),source=constitutive_j2_tau0(instance)) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%state (sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase),source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase),source=0.0_pReal) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase),source=0.0_pReal) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) -#endif - endif + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif myPhase enddo initializeInstances end subroutine constitutive_j2_init -#ifndef NEWSTATE -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!> @details initial microstructural state is set to the value specified by tau0 -! not needed for new state -!-------------------------------------------------------------------------------------------------- -pure function constitutive_j2_stateInit(instance) - - implicit none - real(pReal), dimension(1) :: constitutive_j2_stateInit - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - - constitutive_j2_stateInit = constitutive_j2_tau0(instance) - - -end function constitutive_j2_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -! not needed for new state -!-------------------------------------------------------------------------------------------------- -pure function constitutive_j2_aTolState(instance) - - implicit none - real(pReal), dimension(1) :: constitutive_j2_aTolState - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - - - constitutive_j2_aTolState = constitutive_j2_aTolResistance(instance) - -end function constitutive_j2_aTolState - -#endif !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -pure subroutine constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,state,ipc,ip,el) - use prec, only: & - p_vec +subroutine constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) use math, only: & math_mul6x6, & math_Mandel6to33, & @@ -389,6 +352,8 @@ pure subroutine constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,state,ip mesh_NcpElems, & mesh_maxNips use material, only: & + mappingConstitutive, & + plasticState, & homogenization_maxNgrains, & material_phase, & phase_plasticityInstance @@ -405,13 +370,6 @@ pure subroutine constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,state,ip ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(1), intent(in) :: & - state -#else - type(p_vec), intent(in) :: & - state !< microstructure state -#endif real(pReal), dimension(3,3) :: & Tstar_dev_33 !< deviatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor @@ -434,15 +392,11 @@ pure subroutine constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,state,ip Lp = 0.0_pReal dLp_dTstar99 = 0.0_pReal else -#ifdef NEWSTATE gamma_dot = constitutive_j2_gdot0(instance) & - * (sqrt(1.5_pReal) * norm_Tstar_dev / constitutive_j2_fTaylor(instance) / state(1)) & + * (sqrt(1.5_pReal) * norm_Tstar_dev / (constitutive_j2_fTaylor(instance) * & + plasticState(mappingConstitutive(2,ipc,ip,el))%state(1,mappingConstitutive(1,ipc,ip,el)))) & **constitutive_j2_n(instance) -#else - gamma_dot = constitutive_j2_gdot0(instance) & - * (sqrt(1.5_pReal) * norm_Tstar_dev / constitutive_j2_fTaylor(instance) / state%p(1)) & - **constitutive_j2_n(instance) -#endif + Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/constitutive_j2_fTaylor(instance) !-------------------------------------------------------------------------------------------------- @@ -463,23 +417,21 @@ end subroutine constitutive_j2_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -pure function constitutive_j2_dotState(Tstar_v,state,ipc,ip,el) - use prec, only: & - p_vec +subroutine constitutive_j2_dotState(Tstar_v,ipc,ip,el) use math, only: & math_mul6x6 use mesh, only: & mesh_NcpElems, & mesh_maxNips use material, only: & + mappingConstitutive, & + plasticState, & homogenization_maxNgrains, & material_phase, & phase_plasticityInstance implicit none - real(pReal), dimension(1) :: & - constitutive_j2_dotState -real(pReal) :: & + real(pReal) :: & tempState real(pReal), dimension(6), intent(in):: & Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation @@ -487,13 +439,6 @@ real(pReal) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(1), intent(in) :: & - state -#else - type(p_vec), intent(in) :: & - state !< microstructure state -#endif real(pReal), dimension(6) :: & Tstar_dev_v !< deviatoric part of the 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal) :: & @@ -502,14 +447,14 @@ real(pReal) :: & saturation, & !< saturation resistance norm_Tstar_dev !< euclidean norm of Tstar_dev integer(pInt) :: & - instance -#ifdef NEWSTATE - tempState = state(1) -#else - tempState = state%p(1) -#endif + instance, & !< instance of my instance (unique number of my constitutive model) + of, & !< shortcut notation for offset position in state array + ph !< shortcut notation for phase ID (unique number of all phases, regardless of constitutive model) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + !-------------------------------------------------------------------------------------------------- ! norm of deviatoric part of 2nd Piola-Kirchhoff stress Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal @@ -518,9 +463,9 @@ real(pReal) :: & !-------------------------------------------------------------------------------------------------- ! strain rate - gamma_dot = constitutive_j2_gdot0(instance) * ( sqrt(1.5_pReal) * norm_Tstar_dev & + gamma_dot = constitutive_j2_gdot0(instance) * ( sqrt(1.5_pReal) * norm_Tstar_dev & / &!----------------------------------------------------------------------------------- - (constitutive_j2_fTaylor(instance) * tempState) ) ** constitutive_j2_n(instance) + (constitutive_j2_fTaylor(instance)*plasticState(ph)%state(1,of)) )**constitutive_j2_n(instance) !-------------------------------------------------------------------------------------------------- ! hardening coefficient @@ -543,21 +488,20 @@ real(pReal) :: & endif hardening = ( constitutive_j2_h0(instance) + constitutive_j2_h0_slopeLnRate(instance) * log(gamma_dot) ) & * abs( 1.0_pReal - tempState/saturation )**constitutive_j2_a(instance) & - * sign(1.0_pReal, 1.0_pReal - tempState/saturation) + * sign(1.0_pReal, 1.0_pReal - plasticState(ph)%state(1,of)/saturation) else hardening = 0.0_pReal endif + + plasticState(ph)%dotState(1,of) = hardening * gamma_dot !!!!!!!!!!!!!check if dostate + +end subroutine constitutive_j2_dotState + - constitutive_j2_dotState = hardening * gamma_dot - -end function constitutive_j2_dotState - !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -pure function constitutive_j2_postResults(Tstar_v,state,ipc,ip,el) - use prec, only: & - p_vec +function constitutive_j2_postResults(Tstar_v,ipc,ip,el) use math, only: & math_mul6x6 use mesh, only: & @@ -566,6 +510,8 @@ pure function constitutive_j2_postResults(Tstar_v,state,ipc,ip,el) use material, only: & homogenization_maxNgrains, & material_phase, & + plasticState, & + mappingConstitutive, & phase_plasticityInstance, & phase_Noutput @@ -576,15 +522,6 @@ pure function constitutive_j2_postResults(Tstar_v,state,ipc,ip,el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal) :: & - tempState -#ifdef NEWSTATE - real(pReal), dimension(1), intent(in) :: & - state -#else - type(p_vec), intent(in) :: & - state !< microstructure state -#endif real(pReal), dimension(constitutive_j2_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & constitutive_j2_postResults @@ -593,16 +530,14 @@ pure function constitutive_j2_postResults(Tstar_v,state,ipc,ip,el) real(pReal) :: & norm_Tstar_dev ! euclidean norm of Tstar_dev integer(pInt) :: & - instance, & - o, & - c + instance, & !< instance of my instance (unique number of my constitutive model) + of, & !< shortcut notation for offset position in state array + ph, & !< shortcut notation for phase ID (unique number of all phases, regardless of constitutive model) + c, & + o -#ifdef NEWSTATE - tempState = state(1) -#else - tempState = state%p(1) -#endif - + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) !-------------------------------------------------------------------------------------------------- @@ -617,13 +552,13 @@ pure function constitutive_j2_postResults(Tstar_v,state,ipc,ip,el) outputsLoop: do o = 1_pInt,constitutive_j2_Noutput(instance) select case(constitutive_j2_outputID(o,instance)) case (flowstress_ID) - constitutive_j2_postResults(c+1_pInt) = tempState + constitutive_j2_postResults(c+1_pInt) = plasticState(ph)%state(1,of) c = c + 1_pInt case (strainrate_ID) constitutive_j2_postResults(c+1_pInt) = & constitutive_j2_gdot0(instance) * ( sqrt(1.5_pReal) * norm_Tstar_dev & / &!---------------------------------------------------------------------------------- - (constitutive_j2_fTaylor(instance) * tempState) ) ** constitutive_j2_n(instance) + (constitutive_j2_fTaylor(instance) * plasticState(ph)%state(1,of)) ) ** constitutive_j2_n(instance) c = c + 1_pInt end select enddo outputsLoop diff --git a/code/constitutive_none.f90 b/code/constitutive_none.f90 index e00c62449..9a9527077 100644 --- a/code/constitutive_none.f90 +++ b/code/constitutive_none.f90 @@ -12,10 +12,6 @@ module constitutive_none implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & -#ifndef NEWSTATE - constitutive_none_sizeDotState, & - constitutive_none_sizeState, & -#endif constitutive_none_sizePostResults integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -45,11 +41,8 @@ subroutine constitutive_none_init(fileUnit) phase_plasticity, & phase_Noutput, & PLASTICITY_NONE_label, & -#ifdef NEWSTATE material_phase, & plasticState, & - phase_plasticityInstance, & -#endif PLASTICITY_none_ID, & MATERIAL_partPhase @@ -57,7 +50,6 @@ subroutine constitutive_none_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt) :: & - instance, & maxNinstance, & phase, & NofMyPhase, & @@ -75,39 +67,36 @@ subroutine constitutive_none_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(constitutive_none_sizePostResults(maxNinstance), source=0_pInt) -#ifdef NEWSTATE initializeInstances: do phase = 1_pInt, size(phase_plasticity) + if (phase_plasticity(phase) == PLASTICITY_none_ID) then NofMyPhase=count(material_phase==phase) - if (phase_plasticity(phase) == PLASTICITY_none_ID .and. NofMyPhase/=0) then - instance = phase_plasticityInstance(phase) + sizeState = 0_pInt plasticState(phase)%sizeState = sizeState sizeDotState = sizeState plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizePostResults = constitutive_none_sizePostResults(instance) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%partionedState0(sizeState,NofMyPhase)) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%state (sizeState,NofMyPhase)) - allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase)) - allocate(plasticState(phase)%aTolState (NofMyPhase)) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%dotState_backup(sizeDotState,NofMyPhase)) + plasticState(phase)%sizePostResults = 0_pInt + allocate(plasticState(phase)%aTolState (sizeState)) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase)) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase)) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase)) + allocate(plasticState(phase)%state (sizeState,NofMyPhase)) + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase)) + + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase)) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase)) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase)) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) endif enddo initializeInstances -#else - allocate(constitutive_none_sizeDotState(maxNinstance), source=1_pInt) - allocate(constitutive_none_sizeState(maxNinstance), source=1_pInt) -#endif + + allocate(constitutive_none_sizePostResults(maxNinstance), source=0_pInt) end subroutine constitutive_none_init diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 2de14c1c3..2cdc4c60c 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -293,18 +293,15 @@ use material, only: homogenization_maxNgrains, & phase_Noutput, & PLASTICITY_NONLOCAL_label, & PLASTICITY_NONLOCAL_ID, & -#ifdef NEWSTATE plasticState, & - material_phase, & +! material_phase, & material_Nphase, & -#endif - MATERIAL_partPhase + MATERIAL_partPhase ,& + material_phase use lattice +use numerics,only: & + numerics_integrator -#ifdef NEWSTATE - use numerics,only: & - numerics_integrator -#endif implicit none integer(pInt), intent(in) :: fileUnit @@ -334,10 +331,11 @@ integer(pInt) :: phase, & character(len=65536) :: & tag = '', & line = '' -#ifdef NEWSTATE + integer(pInt) :: sizeState, sizeDotState,sizeDependentState - integer(pInt) :: NofMyPhase -#endif + + + integer(pInt) :: NofMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>' write(6,'(a)') ' $Id$' @@ -345,7 +343,7 @@ integer(pInt) :: phase, & #include "compilation_info.f90" maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) - if (maxNinstances == 0) return ! we don't have to do anything if there's no instance for this constitutive law + if (maxNinstances == 0) return ! we don't have to do anything if there's no instance for this constitutive law if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances @@ -1040,10 +1038,8 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), source=0.0_pReal) initializeInstances: do phase = 1_pInt, size(phase_plasticity) - if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then -#ifdef NEWSTATE - NofMyPhase=count(material_phase==phase) -#endif + NofMyPhase=count(material_phase==phase) + if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID .and. NofMyPhase/=0) then instance = phase_plasticityInstance(phase) !*** Inverse lookup of my slip system family and the slip system in lattice @@ -1059,15 +1055,9 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), !*** determine size of state array ns = totalNslip(instance) - constitutive_nonlocal_sizeDotState(instance) = int(size(BASICSTATES),pInt) * ns - constitutive_nonlocal_sizeDependentState(instance) = int(size(DEPENDENTSTATES),pInt) * ns - constitutive_nonlocal_sizeState(instance) = constitutive_nonlocal_sizeDotState(instance) & - + constitutive_nonlocal_sizeDependentState(instance) & - + int(size(OTHERSTATES),pInt) * ns -#ifdef NEWSTATE ! Determine size of state array -! plasticState(phase)%nonlocal = .true. + ! plasticState(phase)%nonlocal = .true. sizeDotState = int(size(BASICSTATES),pInt) * ns sizeDependentState = int(size(DEPENDENTSTATES),pInt) * ns sizeState = sizeDotState + sizeDependentState & @@ -1093,7 +1083,6 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (any(numerics_integrator == 5_pInt)) & allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) -#endif !*** determine indices to state array @@ -1246,9 +1235,6 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), constitutive_nonlocal_sizePostResults(instance) = constitutive_nonlocal_sizePostResults(instance) + mySize endif enddo outputsLoop -#ifdef NEWSTATE - plasticState(phase)%sizePostResults = constitutive_nonlocal_sizePostResults(instance) -#endif do s1 = 1_pInt,ns f = slipFamily(s1,instance) @@ -1319,9 +1305,7 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), + lattice_Sslip(1:3,1:3,1,slipSystemLattice(s,instance),phase) enddo endif -#ifdef NEWSTATE call constitutive_nonlocal_aTolState(phase,instance) -#endif enddo initializeInstances end subroutine constitutive_nonlocal_init @@ -1329,11 +1313,8 @@ end subroutine constitutive_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief sets the initial microstructural state for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE + subroutine constitutive_nonlocal_stateInit() -#else -subroutine constitutive_nonlocal_stateInit(state) -#endif use IO, only: IO_error use lattice, only: lattice_maxNslipFamily use math, only: math_sampleGaussVar @@ -1345,28 +1326,17 @@ use mesh, only: mesh_ipVolume, & FE_geomtype use material, only: material_phase, & phase_plasticityInstance, & -#ifdef NEWSTATE plasticState, & mappingConstitutive, & material_Nphase, & -#endif phase_plasticity ,& PLASTICITY_NONLOCAL_ID -#ifdef NEWSTATE use numerics,only: & numerics_integrator -#endif implicit none -#ifndef NEWSTATE -type(p_vec), dimension(1,mesh_maxNips,mesh_NcpElems), intent(inout) :: & - state ! microstructural state -#endif - -integer(pInt) el, & - ip, & - e, & +integer(pInt) :: e, & i, & ns, & ! short notation for total number of active slip systems f, & ! index of lattice family @@ -1376,7 +1346,6 @@ integer(pInt) el, & t, & j, & instance, & - phase, & maxNinstances real(pReal), dimension(2) :: noise real(pReal), dimension(4) :: rnd @@ -1387,16 +1356,6 @@ real(pReal) meanDensity, & maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) -#ifndef NEWSTATE -! ititalize all states to zero (already done for new state) -do e = 1_pInt,mesh_NcpElems - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e))) & - state(1,i,e)%p = 0.0_pReal - enddo -enddo -#endif - do instance = 1_pInt,maxNinstances ns = totalNslip(instance) @@ -1405,7 +1364,7 @@ do instance = 1_pInt,maxNinstances ! get the total volume of the instance - minimumIpVolume = 1e99_pReal !use huge here? + minimumIpVolume = huge(1.0_pReal) totalVolume = 0.0_pReal do e = 1_pInt,mesh_NcpElems do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) @@ -1423,20 +1382,16 @@ do instance = 1_pInt,maxNinstances meanDensity = 0.0_pReal do while(meanDensity < rhoSglRandom(instance)) call random_number(rnd) - el = nint(rnd(1)*real(mesh_NcpElems,pReal)+0.5_pReal,pInt) - ip = nint(rnd(2)*real(FE_Nips(FE_geomtype(mesh_element(2,el))),pReal)+0.5_pReal,pInt) - if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,ip,el)) & - .and. instance == phase_plasticityInstance(material_phase(1,ip,el))) then + e = nint(rnd(1)*real(mesh_NcpElems,pReal)+0.5_pReal,pInt) + i = nint(rnd(2)*real(FE_Nips(FE_geomtype(mesh_element(2,e))),pReal)+0.5_pReal,pInt) + if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & + .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then s = nint(rnd(3)*real(ns,pReal)+0.5_pReal,pInt) t = nint(rnd(4)*4.0_pReal+0.5_pReal,pInt) - meanDensity = meanDensity + densityBinning * mesh_ipVolume(ip,el) / totalVolume -#ifdef NEWSTATE - plasticState(mappingConstitutive(2,1,ip,el))%state0(iRhoU(s,t,instance),mappingConstitutive(2,1,ip,el)) = & - plasticState(mappingConstitutive(2,1,ip,el))%state0(iRhoU(s,t,instance),mappingConstitutive(2,1,ip,el)) & + meanDensity = meanDensity + densityBinning * mesh_ipVolume(i,e) / totalVolume + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,t,instance),mappingConstitutive(2,1,i,e)) = & + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,t,instance),mappingConstitutive(2,1,i,e)) & + densityBinning -#else - state(1,ip,el)%p(iRhoU(s,t,instance)) = state(1,ip,el)%p(iRhoU(s,t,instance)) + densityBinning -#endif endif enddo ! homogeneous distribution of density with some noise @@ -1452,32 +1407,19 @@ do instance = 1_pInt,maxNinstances do j = 1_pInt,2_pInt noise(j) = math_sampleGaussVar(0.0_pReal, rhoSglScatter(instance)) enddo -#ifdef NEWSTATE - plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,1,instance),mappingConstitutive(2,1,i,e)) = & + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,1,instance),mappingConstitutive(1,1,i,e)) = & rhoSglEdgePos0(f,instance) + noise(1) - plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,2,instance),mappingConstitutive(2,1,i,e)) = & + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,2,instance),mappingConstitutive(1,1,i,e)) = & rhoSglEdgeNeg0(f,instance) + noise(1) - plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,3,instance),mappingConstitutive(2,1,i,e)) = & + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,3,instance),mappingConstitutive(1,1,i,e)) = & rhoSglScrewPos0(f,instance) + noise(2) - plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,4,instance),mappingConstitutive(2,1,i,e)) = & + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoU(s,4,instance),mappingConstitutive(1,1,i,e)) = & rhoSglScrewNeg0(f,instance) + noise(2) -#else - - state(1,i,e)%p(iRhoU(s,1,instance)) = rhoSglEdgePos0(f,instance) + noise(1) - state(1,i,e)%p(iRhoU(s,2,instance)) = rhoSglEdgeNeg0(f,instance) + noise(1) - state(1,i,e)%p(iRhoU(s,3,instance)) = rhoSglScrewPos0(f,instance) + noise(2) - state(1,i,e)%p(iRhoU(s,4,instance)) = rhoSglScrewNeg0(f,instance) + noise(2) -#endif enddo -#ifdef NEWSTATE - plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoD(from:upto,1,instance),mappingConstitutive(2,1,i,e)) = & + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoD(from:upto,1,instance),mappingConstitutive(1,1,i,e)) = & rhoDipEdge0(f,instance) - plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoD(from:upto,2,instance),mappingConstitutive(2,1,i,e)) = & + plasticState(mappingConstitutive(2,1,i,e))%state0(iRhoD(from:upto,2,instance),mappingConstitutive(1,1,i,e)) = & rhoDipScrew0(f,instance) -#else - state(1,i,e)%p(iRhoD(from:upto,1,instance)) = rhoDipEdge0(f,instance) - state(1,i,e)%p(iRhoD(from:upto,2,instance)) = rhoDipScrew0(f,instance) -#endif enddo endif enddo @@ -1487,77 +1429,38 @@ enddo end subroutine constitutive_nonlocal_stateInit -#ifdef NEWSTATE + !-------------------------------------------------------------------------------------------------- !> @brief sets the relevant state values for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -subroutine constitutive_nonlocal_aTolState(phase,instance) -use material, only: & - plasticState -implicit none -!*** input variables -integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - phase - real(pReal), dimension(plasticState(phase)%sizeState) :: tempTol -!*** local variables - integer(pInt) :: ns, t, c - - - tempTol = 0.0_pReal +subroutine constitutive_nonlocal_aTolState(ph,instance) + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + integer(pInt) :: & + ns, & + t, c + ns = totalNslip(instance) -! constitutive_nonlocal_aTolState = 0.0_pReal -forall (t = 1_pInt:4_pInt) - tempTol(iRhoU(1:ns,t,instance)) = aTolRho(instance) - tempTol(iRhoB(1:ns,t,instance)) = aTolRho(instance) -endforall -forall (c = 1_pInt:2_pInt) & - tempTol(iRhoD(1:ns,c,instance)) = aTolRho(instance) - tempTol(iGamma(1:ns,instance)) = aTolShear(instance) - plasticState(phase)%aTolState(1:plasticState(phase)%sizeDotState) = & - tempTol(1:plasticState(phase)%sizeDotState) + forall (t = 1_pInt:4_pInt) + plasticState(ph)%aTolState(iRhoU(1:ns,t,instance)) = aTolRho(instance) + plasticState(ph)%aTolState(iRhoB(1:ns,t,instance)) = aTolRho(instance) + end forall + forall (c = 1_pInt:2_pInt) & + plasticState(ph)%aTolState(iRhoD(1:ns,c,instance)) = aTolRho(instance) + + plasticState(ph)%aTolState(iGamma(1:ns,instance)) = aTolShear(instance) end subroutine constitutive_nonlocal_aTolState -#else -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -pure function constitutive_nonlocal_aTolState(instance) - -implicit none -!*** input variables -integer(pInt), intent(in) :: instance ! number specifying the current instance of the plasticity - -!*** output variables -real(pReal), dimension(constitutive_nonlocal_sizeState(instance)) :: & - constitutive_nonlocal_aTolState ! absolute state tolerance for the current instance of this plasticity - -!*** local variables -integer(pInt) :: ns, t, c - -ns = totalNslip(instance) -constitutive_nonlocal_aTolState = 0.0_pReal -forall (t = 1_pInt:4_pInt) - constitutive_nonlocal_aTolState(iRhoU(1:ns,t,instance)) = aTolRho(instance) - constitutive_nonlocal_aTolState(iRhoB(1:ns,t,instance)) = aTolRho(instance) -endforall -forall (c = 1_pInt:2_pInt) & - constitutive_nonlocal_aTolState(iRhoD(1:ns,c,instance)) = aTolRho(instance) -constitutive_nonlocal_aTolState(iGamma(1:ns,instance)) = aTolShear(instance) - -end function constitutive_nonlocal_aTolState -#endif - !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE -subroutine constitutive_nonlocal_microstructure(Fe, Fp, ipc, ip, el) -#else -subroutine constitutive_nonlocal_microstructure(state, Fe, Fp, ipc, ip, el) -#endif - +subroutine constitutive_nonlocal_microstructure(Fe, Fp, ip, el) use IO, only: & IO_error use math, only: & @@ -1593,10 +1496,8 @@ use material, only: & homogenization_maxNgrains, & material_phase, & phase_localPlasticity, & -#ifdef NEWSTATE plasticState, & mappingConstitutive, & -#endif phase_plasticityInstance use lattice, only: & lattice_sd, & @@ -1609,31 +1510,22 @@ use lattice, only: & implicit none -!*** input variables -integer(pInt), intent(in) :: ipc, & ! current grain ID - ip, & ! current integration point +integer(pInt), intent(in) :: ip, & ! current integration point el ! current element real(pReal), dimension(3,3), intent(in) :: & Fe, & ! elastic deformation gradient Fp ! elastic deformation gradient -#ifndef NEWSTATE -type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: & - state ! microstructural state -#else integer(pInt) :: & - p, & !< phase - o, & !< offset + ph, & !< phase + of, & !< offset np, & !< neighbor phase no !< nieghbor offset -#endif -!*** local variables integer(pInt) neighbor_el, & ! element number of neighboring material point neighbor_ip, & ! integration point of neighboring material point instance, & ! my instance of this plasticity neighbor_instance, & ! instance of this plasticity of neighboring material point - phase, & neighbor_phase, & ns, & ! total number of active slip systems at my material point neighbor_ns, & ! total number of active slip systems at neighboring material point @@ -1655,7 +1547,7 @@ real(pReal), dimension(2) :: rhoExcessGradient, & rhoTotal real(pReal), dimension(3) :: rhoExcessDifferences, & normal_latticeConf -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoForest, & ! forest dislocation density tauBack, & ! back stress from pileup on same slip system tauThreshold ! threshold shear stress @@ -1665,44 +1557,37 @@ real(pReal), dimension(3,3) :: invFe, & ! inverse of elast invConnections real(pReal), dimension(3,mesh_maxNipNeighbors) :: & connection_latticeConf -real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & +real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoExcess -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),2) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip ! dipole dislocation density (edge, screw) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))), & - totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & + totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix real(pReal), dimension(2,maxval(totalNslip),mesh_maxNipNeighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point -real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),2) :: & +real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & m ! direction of dislocation motion logical inversionError -phase = material_phase(ipc,ip,el) -instance = phase_plasticityInstance(phase) +ph = mappingConstitutive(2,1,ip,el) +of = mappingConstitutive(1,1,ip,el) +instance = phase_plasticityInstance(ph) ns = totalNslip(instance) !*** get basic states -#ifdef NEWSTATE -p = mappingConstitutive(2,ipc,ip,el) -o = mappingConstitutive(1,ipc,ip,el) + + forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) + rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & - rhoDip(s,c) = max(plasticState(p)%state(iRhoD(s,c,instance),o), 0.0_pReal) ! ensure positive dipole densities -#else -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = state(ipc,ip,el)%p(iRhoB(s,t,instance)) -endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & - rhoDip(s,c) = max(state(ipc,ip,el)%p(iRhoD(s,c,instance)), 0.0_pReal) ! ensure positive dipole densities -#endif + rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities + where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & .or. abs(rhoSgl) < significantRho(instance)) & rhoSgl = 0.0_pReal @@ -1726,7 +1611,7 @@ forall (s = 1_pInt:ns) & myInteractionMatrix = 0.0_pReal myInteractionMatrix(1:ns,1:ns) = interactionMatrixSlipSlip(1:ns,1:ns,instance) -if (lattice_structure(phase) == LATTICE_bcc_ID .or. lattice_structure(phase) == LATTICE_fcc_ID) then ! only fcc and bcc +if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc do s = 1_pInt,ns myRhoForest = max(rhoForest(s),significantRho(instance)) correction = ( 1.0_pReal - linetensionEffect(instance) & @@ -1737,7 +1622,7 @@ if (lattice_structure(phase) == LATTICE_bcc_ID .or. lattice_structure(phase) == enddo endif forall (s = 1_pInt:ns) & - tauThreshold(s) = lattice_mu(phase) * burgers(s,instance) & + tauThreshold(s) = lattice_mu(ph) * burgers(s,instance) & * sqrt(dot_product((sum(abs(rhoSgl),2) + sum(abs(rhoDip),2)), myInteractionMatrix(s,1:ns))) @@ -1746,7 +1631,7 @@ forall (s = 1_pInt:ns) & tauBack = 0.0_pReal -if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance)) then +if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) then call math_invert33(Fe, invFe, detFe, inversionError) call math_invert33(Fp, invFp, detFp, inversionError) rhoExcess(1,1:ns) = rhoSgl(1:ns,1) - rhoSgl(1:ns,2) @@ -1760,12 +1645,10 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) -#ifdef NEWSTATE - np = mappingConstitutive(2,ipc,neighbor_ip,neighbor_el) - no = mappingConstitutive(1,ipc,neighbor_ip,neighbor_el) -#endif + np = mappingConstitutive(2,1,neighbor_ip,neighbor_el) + no = mappingConstitutive(1,1,neighbor_ip,neighbor_el) if (neighbor_el > 0 .and. neighbor_ip > 0) then - neighbor_phase = material_phase(ipc,neighbor_ip,neighbor_el) + neighbor_phase = material_phase(1,neighbor_ip,neighbor_el) neighbor_instance = phase_plasticityInstance(neighbor_phase) neighbor_ns = totalNslip(neighbor_instance) if (.not. phase_localPlasticity(neighbor_phase) & @@ -1773,7 +1656,7 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance if (neighbor_ns == ns) then nRealNeighbors = nRealNeighbors + 1_pInt forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) -#ifdef NEWSTATE + neighbor_rhoExcess(c,s,n) = & max(plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no), 0.0_pReal) & ! positive mobiles - max(plasticState(np)%state(iRhoU(s,2*c,neighbor_instance), no), 0.0_pReal) ! negative mobiles @@ -1783,17 +1666,7 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance + abs(plasticState(np)%state(iRhoB(s,2*c-1,neighbor_instance),no)) & ! positive deads + abs(plasticState(np)%state(iRhoB(s,2*c,neighbor_instance), no)) & ! negative deads + max(plasticState(np)%state(iRhoD(s,c,neighbor_instance), no), 0.0_pReal) ! dipoles -#else - neighbor_rhoExcess(c,s,n) = & - max(state(ipc,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c-1,neighbor_instance)), 0.0_pReal) &! positive mobiles - - max(state(ipc,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c,neighbor_instance)), 0.0_pReal) ! negative mobiles - neighbor_rhoTotal(c,s,n) = & - max(state(ipc,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c-1,neighbor_instance)), 0.0_pReal) &! positive mobiles - + max(state(ipc,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c,neighbor_instance)), 0.0_pReal) & ! negative mobiles - + abs(state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c-1,neighbor_instance))) & ! positive deads - + abs(state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c,neighbor_instance))) & ! negative deads - + max(state(ipc,neighbor_ip,neighbor_el)%p(iRhoD(s,c,neighbor_instance)), 0.0_pReal) ! dipoles -#endif + endforall connection_latticeConf(1:3,n) = & math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & @@ -1824,8 +1697,8 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance !* 1. interpolation of the excess density in the neighorhood !* 2. interpolation of the dead dislocation density in the central volume - m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),phase) - m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),phase) + m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),ph) + m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),ph) do s = 1_pInt,ns @@ -1866,8 +1739,8 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance !* gives the local stress correction when multiplied with a factor - tauBack(s) = - lattice_mu(phase) * burgers(s,instance) / (2.0_pReal * pi) & - * (rhoExcessGradient_over_rho(1) / (1.0_pReal - lattice_nu(phase)) & + tauBack(s) = - lattice_mu(ph) * burgers(s,instance) / (2.0_pReal * pi) & + * (rhoExcessGradient_over_rho(1) / (1.0_pReal - lattice_nu(ph)) & + rhoExcessGradient_over_rho(2)) enddo @@ -1875,27 +1748,18 @@ endif !*** set dependent states -#ifdef NEWSTATE -plasticState(p)%state(iRhoF(1:ns,instance),o) = rhoForest -plasticState(p)%state(iTauF(1:ns,instance),o) = tauThreshold -plasticState(p)%state(iTauB(1:ns,instance),o) = tauBack -#else -state(ipc,ip,el)%p(iRhoF(1:ns,instance)) = rhoForest -state(ipc,ip,el)%p(iTauF(1:ns,instance)) = tauThreshold -state(ipc,ip,el)%p(iTauB(1:ns,instance)) = tauBack -#endif +plasticState(ph)%state(iRhoF(1:ns,instance),of) = rhoForest +plasticState(ph)%state(iTauF(1:ns,instance),of) = tauThreshold +plasticState(ph)%state(iTauB(1:ns,instance),of) = tauBack #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,*) - write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_microstructure at el ip g',el,ip,ipc - write(6,*) + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', rhoForest write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold/1e6 - write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauBack / MPa', tauBack/1e6 - write(6,*) + write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', tauBack/1e6 endif #endif @@ -1906,7 +1770,7 @@ end subroutine constitutive_nonlocal_microstructure !> @brief calculates kinetics !-------------------------------------------------------------------------------------------------- subroutine constitutive_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & - tauThreshold, c, Temperature, ipc, ip, el) + tauThreshold, c, Temperature, ip, el) use debug, only: debug_level, & debug_constitutive, & @@ -1922,18 +1786,17 @@ use material, only: material_phase, & implicit none !*** input variables -integer(pInt), intent(in) :: ipc, & !< current grain number - ip, & !< current integration point +integer(pInt), intent(in) :: ip, & !< current integration point el, & !< current element number c !< dislocation character (1:edge, 2:screw) real(pReal), intent(in) :: Temperature !< temperature -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))), & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))), & intent(in) :: tau, & !< resolved external shear stress (without non Schmid effects) tauNS, & !< resolved external shear stress (including non Schmid effects) tauThreshold !< threshold shear stress !*** output variables -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))), & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))), & intent(out) :: v, & !< velocity dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) @@ -1965,7 +1828,7 @@ real(pReal) tauRel_P, & mobility !< dislocation mobility -instance = phase_plasticityInstance(material_phase(ipc,ip,el)) +instance = phase_plasticityInstance(material_phase(1_pInt,ip,el)) ns = totalNslip(instance) v = 0.0_pReal @@ -2048,11 +1911,9 @@ endif #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,*) - write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_kinetics at el ip ipc',el,ip,ipc - write(6,*) + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_kinetics at el ip',el,ip write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold / 1e6_pReal write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tau / MPa', tau / 1e6_pReal write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauNS / MPa', tauNS / 1e6_pReal @@ -2067,11 +1928,8 @@ end subroutine constitutive_nonlocal_kinetics !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE -subroutine constitutive_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature,ipc, ip, el) -#else -subroutine constitutive_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, state, ipc, ip, el) -#endif +subroutine constitutive_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el) + use math, only: math_Plain3333to99, & math_mul6x6, & math_mul33xx33, & @@ -2085,10 +1943,8 @@ use debug, only: debug_level, & debug_i, & debug_e use material, only: material_phase, & -#ifdef NEWSTATE plasticState, & mappingConstitutive,& -#endif phase_plasticityInstance use lattice, only: lattice_Sslip, & lattice_Sslip_v, & @@ -2098,58 +1954,51 @@ use mesh, only: mesh_ipVolume implicit none !*** input variables -integer(pInt), intent(in) :: ipc, & !< current grain number - ip, & !< current integration point +integer(pInt), intent(in) :: ip, & !< current integration point el !< current element number real(pReal), intent(in) :: Temperature !< temperature real(pReal), dimension(6), intent(in) :: Tstar_v !< 2nd Piola-Kirchhoff stress in Mandel notation -!*** input/output variables -#ifndef NEWSTATE -type(p_vec), intent(inout) :: state !< microstructural state -#endif + !*** output variables real(pReal), dimension(3,3), intent(out) :: Lp !< plastic velocity gradient real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 !< derivative of Lp with respect to Tstar (9x9 matrix) !*** local variables integer(pInt) instance, & !< current instance of this plasticity - phase, & !< phase ns, & !< short notation for the total number of active slip systems i, & j, & k, & l, & - p, & !phase number - o, & !offset + ph, & !phase number + of, & !offset t, & !< dislocation type 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(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl !< single dislocation densities (including blocked) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),4) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & v, & !< velocity tauNS, & !< resolved shear stress including non Schmid and backstress terms dv_dtau, & !< velocity derivative with respect to the shear stress dv_dtauNS !< velocity derivative with respect to the shear stress -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & tau, & !< resolved shear stress including backstress terms gdotTotal, & !< shear rate tauBack, & !< back stress from dislocation gradients on same slip system tauThreshold !< threshold shear stress -#ifdef NEWSTATE !*** shortcut for mapping -p = mappingConstitutive(2,ipc,ip,el) -o = mappingConstitutive(1,ipc,ip,el) -#endif +ph = mappingConstitutive(2,1_pInt,ip,el) +of = mappingConstitutive(1,1_pInt,ip,el) + !*** initialize local variables Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal -phase = material_phase(ipc,ip,el) -instance = phase_plasticityInstance(phase) +instance = phase_plasticityInstance(ph) ns = totalNslip(instance) @@ -2157,32 +2006,24 @@ ns = totalNslip(instance) forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) -#ifdef NEWSTATE - rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) -#else - rhoSgl(s,t) = max(state%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = state%p(iRhoB(s,t,instance)) -#endif + + rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) endforall where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & .or. abs(rhoSgl) < significantRho(instance)) & rhoSgl = 0.0_pReal - -#ifdef NEWSTATE -tauBack = plasticState(p)%state(iTauB(1:ns,instance),o) -tauThreshold = plasticState(p)%state(iTauF(1:ns,instance),o) -#else -tauBack = state%p(iTauB(1:ns,instance)) -tauThreshold = state%p(iTauF(1:ns,instance)) -#endif + +tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) +tauThreshold = plasticState(ph)%state(iTauF(1:ns,instance),of) + !*** get resolved shear stress !*** for screws possible non-schmid contributions are also taken into account do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) tauNS(s,1) = tau(s) tauNS(s,2) = tau(s) if (tau(s) > 0.0_pReal) then @@ -2203,13 +2044,13 @@ tau = tau + tauBack ! edges call constitutive_nonlocal_kinetics(v(1:ns,1), dv_dtau(1:ns,1), dv_dtauNS(1:ns,1), & tau(1:ns), tauNS(1:ns,1), tauThreshold(1:ns), & - 1_pInt, Temperature, ipc, ip, el) + 1_pInt, Temperature, ip, el) v(1:ns,2) = v(1:ns,1) dv_dtau(1:ns,2) = dv_dtau(1:ns,1) dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) !screws -if (lattice_NnonSchmid(phase) == 0_pInt) then ! no non-Schmid contributions +if (lattice_NnonSchmid(ph) == 0_pInt) then ! no non-Schmid contributions forall(t = 3_pInt:4_pInt) v(1:ns,t) = v(1:ns,1) dv_dtau(1:ns,t) = dv_dtau(1:ns,1) @@ -2219,7 +2060,7 @@ else do t = 3_pInt,4_pInt call constitutive_nonlocal_kinetics(v(1:ns,t), dv_dtau(1:ns,t), dv_dtauNS(1:ns,t), & tau(1:ns), tauNS(1:ns,t), tauThreshold(1:ns), & - 2_pInt , Temperature, ipc, ip, el) + 2_pInt , Temperature, ip, el) enddo endif @@ -2227,12 +2068,7 @@ endif !*** store velocity in state forall (t = 1_pInt:4_pInt) & -#ifdef NEWSTATE - plasticState(p)%state(iV(1:ns,t,instance),o) = v(1:ns,t) -#else - state%p(iV(1:ns,t,instance)) = v(1:ns,t) -#endif - + plasticState(ph)%state(iV(1:ns,t,instance),of) = v(1:ns,t) !*** Bauschinger effect forall (s = 1_pInt:ns, t = 5_pInt:8_pInt, rhoSgl(s,t) * v(s,t-4_pInt) < 0.0_pReal) & @@ -2245,26 +2081,26 @@ gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * burgers(1:ns,instance) do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - Lp = Lp + gdotTotal(s) * lattice_Sslip(1:3,1:3,1,sLattice,phase) + Lp = Lp + gdotTotal(s) * lattice_Sslip(1:3,1:3,1,sLattice,ph) ! Schmid contributions to tangent forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,phase) * lattice_Sslip(k,l,1,sLattice,phase) & + + lattice_Sslip(i,j,1,sLattice,ph) * lattice_Sslip(k,l,1,sLattice,ph) & * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * burgers(s,instance) ! non Schmid contributions to tangent if (tau(s) > 0.0_pReal) then forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,phase) & + + lattice_Sslip(i,j,1,sLattice,ph) & * ( nonSchmidProjection(k,l,1,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & + nonSchmidProjection(k,l,3,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & * burgers(s,instance) else forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,phase) & + + lattice_Sslip(i,j,1,sLattice,ph) & * ( nonSchmidProjection(k,l,2,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & + nonSchmidProjection(k,l,4,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & * burgers(s,instance) @@ -2275,11 +2111,9 @@ dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then - write(6,*) - write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_LpandItsTangent at el ip ipc ',el,ip,ipc - write(6,*) + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_LpandItsTangent at el ip',el,ip write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> gdot total / 1e-3',gdotTotal*1e3_pReal write(6,'(a,/,3(12x,3(f12.7,1x),/))') '<< CONST >> Lp',transpose(Lp) endif @@ -2292,12 +2126,7 @@ end subroutine constitutive_nonlocal_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE subroutine constitutive_nonlocal_deltaState(Tstar_v,ip,el) -#else -subroutine constitutive_nonlocal_deltaState(deltaState, state, Tstar_v, ipc,ip,el) -#endif - use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & @@ -2316,40 +2145,21 @@ use mesh, only: mesh_NcpElems, & mesh_ipVolume use material, only: homogenization_maxNgrains, & material_phase, & -#ifdef NEWSTATE plasticState, & mappingConstitutive, & -#endif phase_plasticityInstance implicit none - -!*** input variables -#ifndef NEWSTATE -integer(pInt), intent(in) :: ipc, & ! current grain number - ip, & ! current integration point -#else integer(pInt), intent(in) :: ip, & ! current grain number -#endif el ! current element number real(pReal), dimension(6), intent(in) :: Tstar_v ! current 2nd Piola-Kirchhoff stress in Mandel notation -!*** input/output variables -#ifndef NEWSTATE -type(p_vec), intent(inout) :: & - state ! current microstructural state -real(pReal), dimension(:), intent(out) :: deltaState ! change of state variables / microstructure -#else - integer(pInt) :: & - p, & !< phase - o !< offset -#endif -!*** output variables - -!*** local variables -integer(pInt) phase, & - instance, & ! current instance of this plasticity + integer(pInt) :: & + ph, & !< phase + of !< offset + +integer(pInt) ::instance, & ! current instance of this plasticity ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation t, & ! type of dislocation @@ -2375,43 +2185,29 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == 1)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & - write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_deltaState at el ip ipc ',el,ip,1 + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_deltaState at el ip ',el,ip #endif -phase = material_phase(1,ip,el) -instance = phase_plasticityInstance(phase) -ns = totalNslip(instance) + ph = mappingConstitutive(2,1,ip,el) + of = mappingConstitutive(1,1,ip,el) + instance = phase_plasticityInstance(ph) + ns = totalNslip(instance) !*** shortcut to state variables -#ifdef NEWSTATE - p = mappingConstitutive(2,1,ip,el) - o = mappingConstitutive(1,1,ip,el) - + forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) - v(s,t) = plasticState(p)%state(iV(s,t,instance),o) + rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) + v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(plasticState(p)%state(iRhoD(s,c,instance),o), 0.0_pReal) ! ensure positive dipole densities - dUpperOld(s,c) = plasticState(p)%state(iD(s,c,instance),o) + rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities + dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) endforall - tauBack = plasticState(p)%state(iTauB(1:ns,instance),o) -#else -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(state%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = state%p(iRhoB(s,t,instance)) - v(s,t) = state%p(iV(s,t,instance)) -endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(state%p(iRhoD(s,c,instance)), 0.0_pReal) ! ensure positive dipole densities - dUpperOld(s,c) = state%p(iD(s,c,instance)) -endforall -tauBack = state%p(iTauB(1:ns,instance)) -#endif + tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & .or. abs(rhoSgl) < significantRho(instance)) & @@ -2447,13 +2243,13 @@ enddo do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tauBack(s) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - lattice_nu(phase)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) / (4.0_pReal * pi * abs(tau)) +dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) @@ -2482,11 +2278,8 @@ forall (t=1_pInt:4_pInt) & !*** store new maximum dipole height in state forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & -#ifdef NEWSTATE - plasticState(p)%state(iD(s,c,instance),o) = dUpper(s,c) -#else - state%p(iD(s,c,instance)) = dUpper(s,c) -#endif + plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) + !**************************************************************************** @@ -2494,32 +2287,21 @@ forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & deltaRho = deltaRhoRemobilization & + deltaRhoDipole2SingleStress - -#ifdef NEWSTATE -plasticState(p)%deltaState(:,o) = 0.0_pReal +plasticState(ph)%deltaState(:,of) = 0.0_pReal forall (s = 1:ns, t = 1_pInt:4_pInt) - plasticState(p)%deltaState(iRhoU(s,t,instance),o)= deltaRho(s,t) - plasticState(p)%deltaState(iRhoB(s,t,instance),o) = deltaRho(s,t+4_pInt) + plasticState(ph)%deltaState(iRhoU(s,t,instance),of)= deltaRho(s,t) + plasticState(ph)%deltaState(iRhoB(s,t,instance),of) = deltaRho(s,t+4_pInt) endforall forall (s = 1:ns, c = 1_pInt:2_pInt) & - plasticState(p)%deltaState(iRhoD(s,c,instance),o) = deltaRho(s,c+8_pInt) -#else -deltaState = 0.0_pReal -forall (s = 1:ns, t = 1_pInt:4_pInt) - deltaState(iRhoU(s,t,instance)) = deltaRho(s,t) - deltaState(iRhoB(s,t,instance)) = deltaRho(s,t+4_pInt) -endforall -forall (s = 1:ns, c = 1_pInt:2_pInt) & - deltaState(iRhoD(s,c,instance)) = deltaRho(s,c+8_pInt) -#endif + plasticState(ph)%deltaState(iRhoD(s,c,instance),of) = deltaRho(s,c+8_pInt) + #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(1:ns,1:8) - write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress - write(6,*) + write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress endif #endif @@ -2528,12 +2310,8 @@ end subroutine constitutive_nonlocal_deltaState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE -function constitutive_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, timestep,subfrac, ipc,ip,el) -#else -function constitutive_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, state, state0, timestep, & - subfrac, ipc,ip,el) -#endif +subroutine constitutive_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, timestep,subfrac, ip,el) + use prec, only: DAMASK_NaN use numerics, only: numerics_integrationMode, & numerics_timeSyncing @@ -2569,10 +2347,8 @@ use material, only: homogenization_maxNgrains, & material_phase, & phase_plasticityInstance, & phase_localPlasticity, & -#ifdef NEWSTATE plasticState, & mappingConstitutive, & -#endif phase_plasticity ,& PLASTICITY_NONLOCAL_ID use lattice, only: lattice_Sslip_v, & @@ -2587,8 +2363,7 @@ use lattice, only: lattice_Sslip_v, & implicit none !*** input variables -integer(pInt), intent(in) :: ipc, & !< current grain number - ip, & !< current integration point +integer(pInt), intent(in) :: ip, & !< current integration point el !< current element number real(pReal), intent(in) :: Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -2598,22 +2373,10 @@ real(pReal), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & Fe, & !< elastic deformation gradient Fp !< plastic deformation gradient -#ifndef NEWSTATE -type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - state, & !< current microstructural state - state0 !< microstructural state at beginning of crystallite increment -#endif -!*** output variables -#ifdef NEWSTATE -real(pReal), dimension(:), allocatable :: constitutive_nonlocal_dotState !< evolution of state variables / microstructure -#else -real(pReal), dimension(constitutive_nonlocal_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - constitutive_nonlocal_dotState !< evolution of state variables / microstructure -#endif !*** local variables -integer(pInt) :: phase, & +integer(pInt) :: ph, & instance, & !< current instance of this plasticity neighbor_instance, & !< instance of my neighbor's plasticity ns, & !< short notation for the total number of active slip systems @@ -2627,47 +2390,45 @@ integer(pInt) :: phase, & opposite_el, & !< element index of my opposite neighbor opposite_n, & !< neighbor index pointing to me when looking from my opposite neighbor t, & !< type of dislocation -#ifdef NEWSTATE o,& !< offset shortcut no,& !< neighbour offset shortcut p,& !< phase shortcut np,& !< neighbour phase shortcut -#endif 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(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),10) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),10) :: & rhoDot, & !< density evolution rhoDotMultiplication, & !< density evolution by multiplication rhoDotFlux, & !< density evolution by flux rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide) rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation rhoDotThermalAnnihilation !< density evolution by thermal annihilation -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) rhoSglOriginal, & neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) rhoSgl0, & !< single dislocation densities at start of cryst inc (positive/negative screw and edge without dipoles) my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),4) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & v, & !< current dislocation glide velocity v0, & !< dislocation glide velocity at start of cryst inc my_v, & !< dislocation glide velocity of central ip neighbor_v, & !< dislocation glide velocity of enighboring ip gdot !< shear rates -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,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 nSources -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),2) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) rhoDipOriginal, & dLower, & !< minimum stable dipole distance for edges and screws dUpper !< current maximum stable dipole distance for edges and screws -real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),4) :: & +real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & m !< direction of dislocation motion real(pReal), dimension(3,3) :: my_F, & !< my total deformation gradient neighbor_F, & !< total deformation gradient of my neighbor @@ -2687,22 +2448,21 @@ real(pReal) area, & logical considerEnteringFlux, & considerLeavingFlux -#ifdef NEWSTATE + p = mappingConstitutive(2,1,ip,el) o = mappingConstitutive(1,1,ip,el) -!allocate function var -allocate(constitutive_nonlocal_dotState(plasticState(p)%sizeDotState), source = 0.0_pReal) -#endif + + #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & - write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_dotState at el ip ipc ',el,ip,ipc + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_dotState at el ip ',el,ip #endif -phase = material_phase(ipc,ip,el) -instance = phase_plasticityInstance(phase) +ph = material_phase(1_pInt,ip,el) +instance = phase_plasticityInstance(ph) ns = totalNslip(instance) tau = 0.0_pReal @@ -2711,31 +2471,18 @@ gdot = 0.0_pReal !*** shortcut to state variables -#ifdef NEWSTATE + forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(p)%state((iRhoU(s,t,instance)),o), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(p)%state((iRhoB(s,t,instance)),o) - v(s,t) = plasticState(p)%state((iV(s,t,instance)),o) + rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) + v(s,t) = plasticState(p)%state(iV (s,t,instance),o) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(plasticState(p)%state((iRhoD(s,c,instance)),o), 0.0_pReal) ! ensure positive dipole densities + rhoDip(s,c) = max(plasticState(p)%state(iRhoD(s,c,instance),o), 0.0_pReal) ! ensure positive dipole densities endforall -rhoForest = plasticState(p)%state((iRhoF(1:ns,instance)),o) -tauThreshold = plasticState(p)%state((iTauF(1:ns,instance)),o) -tauBack = plasticState(p)%state((iTauB(1:ns,instance)),o) -#else -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = state(ipc,ip,el)%p(iRhoB(s,t,instance)) - v(s,t) = state(ipc,ip,el)%p(iV(s,t,instance)) -endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(state(ipc,ip,el)%p(iRhoD(s,c,instance)), 0.0_pReal) ! ensure positive dipole densities -endforall -rhoForest = state(ipc,ip,el)%p(iRhoF(1:ns,instance)) -tauThreshold = state(ipc,ip,el)%p(iTauF(1:ns,instance)) -tauBack = state(ipc,ip,el)%p(iTauB(1:ns,instance)) -#endif +rhoForest = plasticState(p)%state(iRhoF(1:ns,instance),o) +tauThreshold = plasticState(p)%state(iTauF(1:ns,instance),o) +tauBack = plasticState(p)%state(iTauB(1:ns,instance),o) rhoSglOriginal = rhoSgl rhoDipOriginal = rhoDip @@ -2747,19 +2494,11 @@ where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance rhoDip = 0.0_pReal if (numerics_timeSyncing) then -#ifdef NEWSTATE forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl0(s,t) = max(plasticState(p)%state0(iRhoU(s,t,instance),o), 0.0_pReal) + rhoSgl0(s,t) = max(plasticState(p)%state0(iRhoU(s,t,instance),o), 0.0_pReal) rhoSgl0(s,t+4_pInt) = plasticState(p)%state0(iRhoB(s,t,instance),o) - v0(s,t) = plasticState(p)%state0(iV(s,t,instance),o) + v0(s,t) = plasticState(p)%state0(iV (s,t,instance),o) endforall -#else - forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl0(s,t) = max(state0(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) - rhoSgl0(s,t+4_pInt) = state0(ipc,ip,el)%p(iRhoB(s,t,instance)) - v0(s,t) = state0(ipc,ip,el)%p(iV(s,t,instance)) - endforall -#endif where (abs(rhoSgl0) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & .or. abs(rhoSgl0) < significantRho(instance)) & rhoSgl0 = 0.0_pReal @@ -2769,8 +2508,8 @@ endif !*** sanity check for timestep -if (timestep <= 0.0_pReal) then ! if illegal timestep... - constitutive_nonlocal_dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) +if (timestep <= 0.0_pReal) then ! if illegal timestep... Why here and not on function entry?? + plasticState(p)%dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) return endif @@ -2784,7 +2523,7 @@ forall (t = 1_pInt:4_pInt) & #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot @@ -2798,14 +2537,14 @@ forall (t = 1_pInt:4_pInt) & do s = 1_pInt,ns ! loop over slip systems sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tauBack(s) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - lattice_nu(phase)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) & +dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) where(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+& @@ -2820,7 +2559,7 @@ dUpper = max(dUpper,dLower) !*** calculate dislocation multiplication rhoDotMultiplication = 0.0_pReal -if (lattice_structure(phase) == LATTICE_bcc_ID) then ! BCC +if (lattice_structure(ph) == LATTICE_bcc_ID) then ! BCC forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path @@ -2841,16 +2580,16 @@ else endwhere do s = 1_pInt,ns if (nSources(s) < 1.0_pReal) then - if (sourceProbability(s,ipc,ip,el) > 1.0_pReal) then + if (sourceProbability(s,1_pInt,ip,el) > 1.0_pReal) then call random_number(rnd) - sourceProbability(s,ipc,ip,el) = rnd + sourceProbability(s,1_pInt,ip,el) = rnd !$OMP FLUSH(sourceProbability) endif - if (sourceProbability(s,ipc,ip,el) > 1.0_pReal - nSources(s)) then + if (sourceProbability(s,1_pInt,ip,el) > 1.0_pReal - nSources(s)) then rhoDotMultiplication(s,1:4) = sum(rhoSglOriginal(s,1:4) * abs(v(s,1:4))) / meshlength endif else - sourceProbability(s,ipc,ip,el) = 2.0_pReal + sourceProbability(s,1_pInt,ip,el) = 2.0_pReal rhoDotMultiplication(s,1:4) = & (sum(abs(gdot(s,1:2))) * fEdgeMultiplication(instance) + sum(abs(gdot(s,3:4)))) & / burgers(s,instance) * sqrt(rhoForest(s)) / lambda0(s,instance) @@ -2858,11 +2597,9 @@ else enddo #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then - write(6,'(a,/,4(12x,12(f12.5,1x),/))') '<< CONST >> sources', nSources - write(6,*) - endif + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) & + write(6,'(a,/,4(12x,12(f12.5,1x),/,/))') '<< CONST >> sources', nSources #endif else rhoDotMultiplication(1:ns,1:4) = spread( & @@ -2877,9 +2614,8 @@ endif !*** calculate dislocation fluxes (only for nonlocal plasticity) rhoDotFlux = 0.0_pReal - -if (.not. phase_localPlasticity(material_phase(ipc,ip,el))) then ! only for nonlocal plasticity - +!? why needed here +if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then ! only for nonlocal plasticity !*** check CFL (Courant-Friedrichs-Lewy) condition for flux @@ -2897,7 +2633,7 @@ if (.not. phase_localPlasticity(material_phase(ipc,ip,el))) then write(6,'(a)') '<< CONST >> enforcing cutback !!!' endif #endif - constitutive_nonlocal_dotState = DAMASK_NaN ! -> return NaN and, hence, enforce cutback + plasticState(p)%dotState = DAMASK_NaN ! -> return NaN and, hence, enforce cutback return endif @@ -2905,23 +2641,21 @@ if (.not. phase_localPlasticity(material_phase(ipc,ip,el))) then !*** be aware of the definition of lattice_st = lattice_sd x lattice_sn !!! !*** opposite sign to our p vector in the (s,p,n) triplet !!! - m(1:3,1:ns,1) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), phase) - m(1:3,1:ns,2) = -lattice_sd(1:3, slipSystemLattice(1:ns,instance), phase) - m(1:3,1:ns,3) = -lattice_st(1:3, slipSystemLattice(1:ns,instance), phase) - m(1:3,1:ns,4) = lattice_st(1:3, slipSystemLattice(1:ns,instance), phase) + m(1:3,1:ns,1) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) + m(1:3,1:ns,2) = -lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) + m(1:3,1:ns,3) = -lattice_st(1:3, slipSystemLattice(1:ns,instance), ph) + m(1:3,1:ns,4) = lattice_st(1:3, slipSystemLattice(1:ns,instance), ph) - my_Fe = Fe(1:3,1:3,ipc,ip,el) - my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,ipc,ip,el)) + my_Fe = Fe(1:3,1:3,1_pInt,ip,el) + my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1_pInt,ip,el)) do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) ! loop through my neighbors +! write(6,*) 'c' neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) neighbor_n = mesh_ipNeighborhood(3,n,ip,el) - -#ifdef NEWSTATE - np = mappingConstitutive(2,ipc,neighbor_ip,neighbor_el) - no = mappingConstitutive(1,ipc,neighbor_ip,neighbor_el) -#endif + np = mappingConstitutive(2,1,neighbor_ip,neighbor_el) + no = mappingConstitutive(1,1,neighbor_ip,neighbor_el) opposite_neighbor = n + mod(n,2_pInt) - mod(n+1_pInt,2_pInt) opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el) @@ -2929,9 +2663,9 @@ if (.not. phase_localPlasticity(material_phase(ipc,ip,el))) then opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el) if (neighbor_n > 0_pInt) then ! if neighbor exists, average deformation gradient - neighbor_instance = phase_plasticityInstance(material_phase(ipc,neighbor_ip,neighbor_el)) - neighbor_Fe = Fe(1:3,1:3,ipc,neighbor_ip,neighbor_el) - neighbor_F = math_mul33x33(neighbor_Fe, Fp(1:3,1:3,ipc,neighbor_ip,neighbor_el)) + neighbor_instance = phase_plasticityInstance(material_phase(1_pInt,neighbor_ip,neighbor_el)) + neighbor_Fe = Fe(1:3,1:3,1_pInt,neighbor_ip,neighbor_el) + neighbor_F = math_mul33x33(neighbor_Fe, Fp(1:3,1:3,1_pInt,neighbor_ip,neighbor_el)) Favg = 0.5_pReal * (my_F + neighbor_F) else ! if no neighbor, take my value as average Favg = my_F @@ -2957,33 +2691,22 @@ if (.not. phase_localPlasticity(material_phase(ipc,ip,el))) then endif if (considerEnteringFlux) then - if(numerics_timeSyncing .and. (subfrac(ipc,neighbor_ip,neighbor_el) /= subfrac(ipc,ip,el))) & + if(numerics_timeSyncing .and. (subfrac(1_pInt,neighbor_ip,neighbor_el) /= subfrac(1_pInt,ip,el))) & then ! for timesyncing: in case of a timestep at the interface we have to use "state0" to make sure that fluxes n both sides are equal -#ifdef NEWSTATE forall (s = 1:ns, t = 1_pInt:4_pInt) - neighbor_v(s,t) = plasticState(np)%state0(iV(s,t,neighbor_instance),no) + + neighbor_v(s,t) = plasticState(np)%state0(iV (s,t,neighbor_instance),no) neighbor_rhoSgl(s,t) = max(plasticState(np)%state0(iRhoU(s,t,neighbor_instance),no),0.0_pReal) + endforall -#else - forall (s = 1:ns, t = 1_pInt:4_pInt) - neighbor_v(s,t) = state0(ipc,neighbor_ip,neighbor_el)%p(iV(s,t,neighbor_instance)) - neighbor_rhoSgl(s,t) = max(state0(ipc,neighbor_ip,neighbor_el)% & - p(iRhoU(s,t,neighbor_instance)), 0.0_pReal) - endforall -#endif else forall (s = 1:ns, t = 1_pInt:4_pInt) -#ifdef NEWSTATE - neighbor_v(s,t) = plasticState(np)%state(iV(s,t, neighbor_instance),no) - neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance), no), & + neighbor_v(s,t) = plasticState(np)%state(iV (s,t,neighbor_instance),no) + neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance),no), & 0.0_pReal) -#else - neighbor_v(s,t) = state(ipc,neighbor_ip,neighbor_el)%p(iV(s,t,neighbor_instance)) - neighbor_rhoSgl(s,t) = max(state(ipc,neighbor_ip,neighbor_el)%p(iRhoU(s,t,neighbor_instance)), & - 0.0_pReal) -#endif endforall endif + where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < significantN(instance) & .or. neighbor_rhoSgl < significantRho(instance)) & neighbor_rhoSgl = 0.0_pReal @@ -3038,11 +2761,11 @@ if (.not. phase_localPlasticity(material_phase(ipc,ip,el))) then my_rhoSgl = rhoSgl my_v = v if(numerics_timeSyncing) then - if (subfrac(ipc,ip,el) == 0.0_pReal) then + if (subfrac(1_pInt,ip,el) == 0.0_pReal) then my_rhoSgl = rhoSgl0 my_v = v0 elseif (neighbor_n > 0_pInt) then - if (subfrac(ipc,neighbor_ip,neighbor_el) == 0.0_pReal) then + if (subfrac(1_pInt,neighbor_ip,neighbor_el) == 0.0_pReal) then my_rhoSgl = rhoSgl0 my_v = v0 endif @@ -3120,11 +2843,11 @@ forall (c=1_pInt:2_pInt) & + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent ! annihilated screw dipoles leave edge jogs behind on the colinear system -if (lattice_structure(phase) == LATTICE_fcc_ID) then ! only fcc +if (lattice_structure(ph) == LATTICE_fcc_ID) & ! only fcc forall (s = 1:ns, colinearSystem(s,instance) > 0_pInt) & rhoDotAthermalAnnihilation(colinearSystem(s,instance),1:2) = - rhoDotAthermalAnnihilation(s,10) & * 0.25_pReal * sqrt(rhoForest(s)) * (dUpper(s,2) + dLower(s,2)) * edgeJogFactor(instance) -endif + !*** thermally activated annihilation of edge dipoles by climb @@ -3132,7 +2855,7 @@ endif rhoDotThermalAnnihilation = 0.0_pReal selfDiffusion = Dsd0(instance) * exp(-selfDiffusionEnergy(instance) / (KB * Temperature)) vClimb = atomicVolume(instance) * selfDiffusion / ( KB * Temperature ) & - * lattice_mu(phase) / ( 2.0_pReal * PI * (1.0_pReal-lattice_nu(phase)) ) & + * lattice_mu(ph) / ( 2.0_pReal * PI * (1.0_pReal-lattice_nu(ph)) ) & * 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) ) forall (s = 1_pInt:ns, dUpper(s,1) > dLower(s,1)) & rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), & @@ -3153,18 +2876,18 @@ rhoDot = rhoDotFlux & + rhoDotThermalAnnihilation if (numerics_integrationMode == 1_pInt) then ! save rates for output if in central integration mode - rhoDotFluxOutput(1:ns,1:8,ipc,ip,el) = rhoDotFlux(1:ns,1:8) - rhoDotMultiplicationOutput(1:ns,1:2,ipc,ip,el) = rhoDotMultiplication(1:ns,[1,3]) - rhoDotSingle2DipoleGlideOutput(1:ns,1:2,ipc,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) - rhoDotAthermalAnnihilationOutput(1:ns,1:2,ipc,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) - rhoDotThermalAnnihilationOutput(1:ns,1:2,ipc,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) - rhoDotEdgeJogsOutput(1:ns,ipc,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) + rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8) + rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3]) + rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) + rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) + rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) + rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) endif #ifndef _OPENMP if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& + .and. ((debug_e == el .and. debug_i == ip .and. debug_g == 1_pInt)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', & rhoDotMultiplication(1:ns,1:4) * timestep @@ -3194,20 +2917,21 @@ if ( any(rhoSglOriginal(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < -aTolRho(in write(6,'(a)') '<< CONST >> enforcing cutback !!!' endif #endif - constitutive_nonlocal_dotState = DAMASK_NaN + plasticState(p)%dotState = DAMASK_NaN return else forall (s = 1:ns, t = 1_pInt:4_pInt) - constitutive_nonlocal_dotState(iRhoU(s,t,instance)) = rhoDot(s,t) - constitutive_nonlocal_dotState(iRhoB(s,t,instance)) = rhoDot(s,t+4_pInt) + plasticState(p)%dotState(iRhoU(s,t,instance),o) = rhoDot(s,t) + plasticState(p)%dotState(iRhoB(s,t,instance),o) = rhoDot(s,t+4_pInt) endforall forall (s = 1:ns, c = 1_pInt:2_pInt) & - constitutive_nonlocal_dotState(iRhoD(s,c,instance)) = rhoDot(s,c+8_pInt) + plasticState(p)%dotState(iRhoD(s,c,instance),o) = rhoDot(s,c+8_pInt) forall (s = 1:ns) & - constitutive_nonlocal_dotState(iGamma(s,instance)) = sum(gdot(s,1:4)) + plasticState(p)%dotState(iGamma(s,instance),o) = sum(gdot(s,1:4)) endif -end function constitutive_nonlocal_dotState +end subroutine constitutive_nonlocal_dotState + !********************************************************************* !* COMPATIBILITY UPDATE * @@ -3250,7 +2974,7 @@ integer(pInt) Nneighbors, & n, & ! neighbor index neighbor_e, & ! element index of my neighbor neighbor_i, & ! integration point index of my neighbor - phase, & + ph, & neighbor_phase, & textureID, & neighbor_textureID, & @@ -3274,12 +2998,12 @@ logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) -phase = material_phase(1,i,e) +ph = material_phase(1,i,e) textureID = material_texture(1,i,e) -instance = phase_plasticityInstance(phase) +instance = phase_plasticityInstance(ph) ns = totalNslip(instance) -slipNormal(1:3,1:ns) = lattice_sn(1:3, slipSystemLattice(1:ns,instance), phase) -slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), phase) +slipNormal(1:3,1:ns) = lattice_sn(1:3, slipSystemLattice(1:ns,instance), ph) +slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) !*** start out fully compatible @@ -3313,8 +3037,8 @@ do n = 1_pInt,Nneighbors !* we do not consider this to be a phase boundary, so completely compatible. neighbor_phase = material_phase(1,neighbor_i,neighbor_e) - if (neighbor_phase /= phase) then - if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(phase)) then + if (neighbor_phase /= ph) then + if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph)) then forall(s1 = 1_pInt:ns) & my_compatibility(1:2,s1,s1,n) = 0.0_pReal ! = sqrt(0.0) endif @@ -3384,11 +3108,7 @@ end subroutine constitutive_nonlocal_updateCompatibility !********************************************************************* !* calculates quantities characterizing the microstructure * !********************************************************************* -#ifdef NEWSTATE -pure function constitutive_nonlocal_dislocationstress(Fe, ipc, ip, el) -#else -pure function constitutive_nonlocal_dislocationstress(state, Fe, ipc, ip, el) -#endif +function constitutive_nonlocal_dislocationstress(Fe, ip, el) use math, only: math_mul33x33, & math_mul33x3, & math_invert33, & @@ -3405,10 +3125,8 @@ use mesh, only: mesh_NcpElems, & FE_geomtype use material, only: homogenization_maxNgrains, & material_phase, & -#ifdef NEWSTATE plasticState, & mappingConstitutive,& -#endif phase_localPlasticity, & phase_plasticityInstance use lattice, only: lattice_mu, & @@ -3417,15 +3135,10 @@ use lattice, only: lattice_mu, & implicit none !*** input variables -integer(pInt), intent(in) :: ipc, & !< current grain ID - ip, & !< current integration point +integer(pInt), intent(in) :: ip, & !< current integration point el !< current element real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & Fe !< elastic deformation gradient -#ifndef NEWSTATE -type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - state !< microstructural state -#endif !*** output variables real(pReal), dimension(3,3) :: constitutive_nonlocal_dislocationstress @@ -3435,18 +3148,16 @@ integer(pInt) neighbor_el, & neighbor_ip, & !< integration point of neighbor material point instance, & !< my instance of this plasticity neighbor_instance, & !< instance of this plasticity of neighbor material point - phase, & + ph, & neighbor_phase, & ns, & !< total number of active slip systems at my material point neighbor_ns, & !< total number of active slip systems at neighbor material point c, & !< index of dilsocation character (edge, screw) s, & !< slip system index -#ifdef NEWSTATE o,& !< offset shortcut no,& !< neighbour offset shortcut p,& !< phase shortcut np,& !< neighbour phase shortcut -#endif t, & !< index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) dir, & deltaX, deltaY, deltaZ, & @@ -3479,29 +3190,23 @@ real(pReal), dimension(2,2,maxval(totalNslip)) :: & neighbor_rhoExcess !< excess density at neighbor material point (edge/screw,mobile/dead,slipsystem) real(pReal), dimension(2,maxval(totalNslip)) :: & rhoExcessDead -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: & +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) logical inversionError -phase = material_phase(ipc,ip,el) -instance = phase_plasticityInstance(phase) +ph = material_phase(1_pInt,ip,el) +instance = phase_plasticityInstance(ph) ns = totalNslip(instance) -#ifdef NEWSTATE - p = mappingConstitutive(2,1,ip,el) - o = mappingConstitutive(1,1,ip,el) -#endif +p = mappingConstitutive(2,1,ip,el) +o = mappingConstitutive(1,1,ip,el) + !*** get basic states forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) -#ifdef NEWSTATE rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) -#else - rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = state(ipc,ip,el)%p(iRhoB(s,t,instance)) -#endif endforall @@ -3511,8 +3216,8 @@ endforall constitutive_nonlocal_dislocationstress = 0.0_pReal -if (.not. phase_localPlasticity(phase)) then - call math_invert33(Fe(1:3,1:3,ipc,ip,el), invFe, detFe, inversionError) +if (.not. phase_localPlasticity(ph)) then + call math_invert33(Fe(1:3,1:3,1_pInt,ip,el), invFe, detFe, inversionError) !* in case of periodic surfaces we have to find out how many periodic images in each direction we need @@ -3536,11 +3241,10 @@ if (.not. phase_localPlasticity(phase)) then do neighbor_el = 1_pInt,mesh_NcpElems ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))) - neighbor_phase = material_phase(ipc,neighbor_ip,neighbor_el) -#ifdef NEWSTATE - np = mappingConstitutive(2,1,neighbor_ip,neighbor_el) - no = mappingConstitutive(1,1,neighbor_ip,neighbor_el) -#endif + neighbor_phase = material_phase(1_pInt,neighbor_ip,neighbor_el) + np = mappingConstitutive(2,1,neighbor_ip,neighbor_el) + no = mappingConstitutive(1,1,neighbor_ip,neighbor_el) + if (phase_localPlasticity(neighbor_phase)) then cycle endif @@ -3550,17 +3254,11 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) neighbor_ipVolumeSideLength = mesh_ipVolume(neighbor_ip,neighbor_el) ** (1.0_pReal/3.0_pReal) ! reference volume used here forall (s = 1_pInt:neighbor_ns, c = 1_pInt:2_pInt) -#ifdef NEWSTATE neighbor_rhoExcess(c,1,s) = plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no) & ! positive mobiles - plasticState(np)%state(iRhoU(s,2*c,neighbor_instance),no) ! negative mobiles neighbor_rhoExcess(c,2,s) = abs(plasticState(np)%state(iRhoB(s,2*c-1,neighbor_instance),no)) & ! positive deads - abs(plasticState(np)%state(iRhoB(s,2*c,neighbor_instance),no)) ! negative deads -#else - neighbor_rhoExcess(c,1,s) = state(ipc,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c-1,neighbor_instance)) & ! positive mobiles - - state(ipc,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c,neighbor_instance)) ! negative mobiles - neighbor_rhoExcess(c,2,s) = abs(state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c-1,neighbor_instance))) & ! positive deads - - abs(state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c,neighbor_instance))) ! negative deads -#endif + endforall Tdislo_neighborLattice = 0.0_pReal do deltaX = periodicImages(1,1),periodicImages(2,1) @@ -3616,17 +3314,11 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) if (abs(neighbor_rhoExcess(1,j,s)) < significantRho(instance)) then cycle elseif (j > 1_pInt) then -#ifdef NEWSTATE x = connection_neighborSlip(1) & + sign(0.5_pReal * segmentLength, & plasticState(np)%state(iRhoB(s,1,neighbor_instance),no) & - plasticState(np)%state(iRhoB(s,2,neighbor_instance),no)) -#else - x = connection_neighborSlip(1) & - + sign(0.5_pReal * segmentLength, & - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,1,neighbor_instance)) & - - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2,neighbor_instance))) -#endif + xsquare = x * x endif @@ -3644,7 +3336,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) * (1.0_pReal + xsquare / Rsquare + xsquare / denominator) & * neighbor_rhoExcess(1,j,s) sigma(2,2) = sigma(2,2) - real(side,pReal) & - * (flipSign * 2.0_pReal * lattice_nu(phase) * z / denominator + z * lambda / Rcube) & + * (flipSign * 2.0_pReal * lattice_nu(ph) * z / denominator + z * lambda / Rcube) & * neighbor_rhoExcess(1,j,s) sigma(3,3) = sigma(3,3) + real(side,pReal) & * flipSign * z / denominator & @@ -3657,7 +3349,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) * (1.0_pReal - zsquare / Rsquare - zsquare / denominator) & * neighbor_rhoExcess(1,j,s) sigma(2,3) = sigma(2,3) - real(side,pReal) & - * (lattice_nu(phase) / R - zsquare / Rcube) * neighbor_rhoExcess(1,j,s) + * (lattice_nu(ph) / R - zsquare / Rcube) * neighbor_rhoExcess(1,j,s) enddo enddo @@ -3668,18 +3360,10 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) if (abs(neighbor_rhoExcess(2,j,s)) < significantRho(instance)) then cycle elseif (j > 1_pInt) then -#ifdef NEWSTATE y = connection_neighborSlip(2) & + sign(0.5_pReal * segmentLength, & plasticState(np)%state(iRhoB(s,3,neighbor_instance),no) & - plasticState(np)%state(iRhoB(s,4,neighbor_instance),no)) -#else - y = connection_neighborSlip(2) & - + sign(0.5_pReal * segmentLength, & - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,3,neighbor_instance)) & - - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,4,neighbor_instance))) -#endif - ysquare = y * y endif @@ -3693,10 +3377,10 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) if (denominator == 0.0_pReal) exit ipLoop sigma(1,2) = sigma(1,2) - real(side,pReal) * flipSign * z & - * (1.0_pReal - lattice_nu(phase)) / denominator & + * (1.0_pReal - lattice_nu(ph)) / denominator & * neighbor_rhoExcess(2,j,s) sigma(1,3) = sigma(1,3) + real(side,pReal) * flipSign * y & - * (1.0_pReal - lattice_nu(phase)) / denominator & + * (1.0_pReal - lattice_nu(ph)) / denominator & * neighbor_rhoExcess(2,j,s) enddo enddo @@ -3730,27 +3414,19 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) else forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & -#ifdef NEWSTATE + rhoExcessDead(c,s) = plasticState(p)%state(iRhoB(s,2*c-1,instance),o) & ! positive deads (here we use symmetry: if this has negative sign it is !treated as negative density at positive position instead of positive !density at negative position) + plasticState(p)%state(iRhoB(s,2*c,instance),o) ! negative deads (here we use symmetry: if this has negative sign it is !treated as positive density at positive position instead of negative !density at negative position) -#else - rhoExcessDead(c,s) = state(ipc,ip,el)%p(iRhoB(s,2*c-1,instance)) & ! positive deads (here we use symmetry: if this has negative sign it is - ! treated as negative density at positive position instead of positive - !density at negative position) - + state(ipc,ip,el)%p(iRhoB(s,2*c,instance)) ! negative deads (here we use symmetry: if this has negative sign it is - !treated as positive density at positive position instead of negative - !density at negative position) -#endif do s = 1_pInt,ns if (all(abs(rhoExcessDead(:,s)) < significantRho(instance))) cycle ! not significant sigma = 0.0_pReal ! all components except for sigma13 are zero - sigma(1,3) = - (rhoExcessDead(1,s) + rhoExcessDead(2,s) * (1.0_pReal - lattice_nu(phase))) & - * neighbor_ipVolumeSideLength * lattice_mu(phase) * burgers(s,instance) & - / (sqrt(2.0_pReal) * pi * (1.0_pReal - lattice_nu(phase))) + sigma(1,3) = - (rhoExcessDead(1,s) + rhoExcessDead(2,s) * (1.0_pReal - lattice_nu(ph))) & + * neighbor_ipVolumeSideLength * lattice_mu(ph) * burgers(s,instance) & + / (sqrt(2.0_pReal) * pi * (1.0_pReal - lattice_nu(ph))) sigma(3,1) = sigma(1,3) Tdislo_neighborLattice = Tdislo_neighborLattice & @@ -3782,538 +3458,10 @@ endif end function constitutive_nonlocal_dislocationstress -!!!!!!!!!! -!!!!!!!!!!! -!!!!!!!!!!!! - -#ifdef NEWSTATE !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function constitutive_nonlocal_postResults(Tstar_v,Fe,mapping,ipc,ip,el) - use math, only: & - math_mul6x6, & - math_mul33x3, & - math_mul33x33, & - pi - use mesh, only: & - mesh_NcpElems, & - mesh_maxNips - use material, only: & - homogenization_maxNgrains, & - material_phase, & - phase_plasticityInstance, & - phase_Noutput, & - plasticState - use lattice, only: & - lattice_Sslip_v, & - lattice_sd, & - lattice_st, & - lattice_sn, & - lattice_mu, & - lattice_nu - - implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - Fe !< elastic deformation gradient -! type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & -! state !< microstructure state -! type(p_vec), intent(in) :: & -! dotState ! evolution rate of microstructural state - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element -integer(pInt),dimension(2,homogenization_maxngrains,mesh_maxNips,mesh_ncpelems), intent(in) :: & - mapping - real(pReal), dimension(constitutive_nonlocal_sizePostResults(& - phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - constitutive_nonlocal_postResults - - integer(pInt) :: & - phase, & - instance, & !< current instance of this plasticity - ns, & !< short notation for the total number of active slip systems - c, & !< character of dislocation - cs, & !< constitutive result index - o, & !< index of current output - 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(totalNslip(phase_plasticityInstance(material_phase(ipc,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(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),4) :: & - gdot, & !< shear rates - v !< velocities - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - rhoForest, & !< forest dislocation density - tauThreshold, & !< threshold shear stress - tau, & !< current resolved shear stress - tauBack !< back stress from pileups on same slip system - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,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,totalNslip(phase_plasticityInstance(material_phase(ipc,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), dimension(3,totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - n_currentconf !< slip system normal (unit vector) in current configuration - real(pReal), dimension(3,3) :: & - sigma - -phase = material_phase(ipc,ip,el) -instance = phase_plasticityInstance(phase) -ns = totalNslip(instance) - -cs = 0_pInt -constitutive_nonlocal_postResults = 0.0_pReal - - -!* short hand notations for state variables - -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = plasticState(mapping(2,ipc,ip,el))%state(iRhoU(s,t,instance),mapping(1,ipc,ip,el)) - rhoSgl(s,t+4_pInt) = plasticState(mapping(2,ipc,ip,el))%state(iRhoB(s,t,instance),mapping(1,ipc,ip,el)) - v(s,t) = plasticState(mapping(2,ipc,ip,el))%state(iV(s,t,instance),mapping(1,ipc,ip,el)) - rhoDotSgl(s,t) = plasticState(mapping(2,ipc,ip,el))%dotState(iRhoU(s,t,instance),mapping(1,ipc,ip,el)) - rhoDotSgl(s,t+4_pInt) = plasticState(mapping(2,ipc,ip,el))%dotState(iRhoB(s,t,instance),mapping(1,ipc,ip,el)) -endforall -forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) -! rhoDip(s,c) = state(ipc,ip,el)%p(iRhoD(s,c,instance)) -! rhoDotDip(s,c) = dotState%p(iRhoD(s,c,instance)) - - rhoDip(s,c) = plasticState(mapping(2,ipc,ip,el))%State(iRhoD(s,c,instance),mapping(1,ipc,ip,el)) - rhoDotDip(s,c) = plasticState(mapping(2,ipc,ip,el))%State(iRhoD(s,c,instance),mapping(1,ipc,ip,el)) -endforall -!tauBack = state(ipc,ip,el)%p(iTauB(1:ns,instance)) - -rhoForest = plasticState(mapping(2,ipc,ip,el))%state(iRhoF(1:ns,instance),mapping(1,ipc,ip,el)) -tauThreshold = plasticState(mapping(2,ipc,ip,el))%state(iTauF(1:ns,instance),mapping(1,ipc,ip,el)) -tauBack = plasticState(mapping(2,ipc,ip,el))%state(iTauB(1:ns,instance),mapping(1,ipc,ip,el)) - - - -!* Calculate shear rate - -forall (t = 1_pInt:4_pInt) & - gdot(1:ns,t) = rhoSgl(1:ns,t) * burgers(1:ns,instance) * v(1:ns,t) - - -!* calculate limits for stable dipole height - -do s = 1_pInt,ns - sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tauBack(s) - if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal -enddo - -dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - lattice_nu(phase)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) & - / (4.0_pReal * pi * abs(tau)) -forall (c = 1_pInt:2_pInt) - where(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+& - abs(rhoSgl(1:ns,2*c+3))+abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)) >= tiny(0.0_pReal)) & - dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & - + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & - dUpper(1:ns,c)) -end forall -dUpper = max(dUpper,dLower) - -!*** dislocation motion - -m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),phase) -m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),phase) -forall (c = 1_pInt:2_pInt, s = 1_pInt:ns) & - m_currentconf(1:3,s,c) = math_mul33x3(Fe(1:3,1:3,ipc,ip,el), m(1:3,s,c)) -forall (s = 1_pInt:ns) & - n_currentconf(1:3,s) = math_mul33x3(Fe(1:3,1:3,ipc,ip,el), & - lattice_sn(1:3,slipSystemLattice(s,instance),phase)) - - -outputsLoop: do o = 1_pInt,phase_Noutput(material_phase(ipc,ip,el)) - select case(constitutive_nonlocal_outputID(o,instance)) - case (rho_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) + sum(rhoDip,2) - cs = cs + ns - - case (rho_sgl_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) - cs = cs + ns - - case (rho_sgl_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,1:4)),2) - cs = cs + ns - - case (rho_sgl_immobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:8),2) - cs = cs + ns - - case (rho_dip_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDip,2) - cs = cs + ns - - case (rho_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1) - cs = cs + ns - - case (rho_sgl_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) - cs = cs + ns - - case (rho_sgl_edge_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,1:2),2) - cs = cs + ns - - case (rho_sgl_edge_immobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:6),2) - cs = cs + ns - - case (rho_sgl_edge_pos_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5)) - cs = cs + ns - - case (rho_sgl_edge_pos_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) - cs = cs + ns - - case (rho_sgl_edge_pos_immobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5) - cs = cs + ns - - case (rho_sgl_edge_neg_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6)) - cs = cs + ns - - case (rho_sgl_edge_neg_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) - cs = cs + ns - - case (rho_sgl_edge_neg_immobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,6) - cs = cs + ns - - case (rho_dip_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1) - cs = cs + ns - - case (rho_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2) - cs = cs + ns - - case (rho_sgl_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) - cs = cs + ns - - case (rho_sgl_screw_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,3:4),2) - cs = cs + ns - - case (rho_sgl_screw_immobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,7:8),2) - cs = cs + ns - - case (rho_sgl_screw_pos_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7)) - cs = cs + ns - - case (rho_sgl_screw_pos_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) - cs = cs + ns - - case (rho_sgl_screw_pos_immobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7) - cs = cs + ns - - case (rho_sgl_screw_neg_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)) - cs = cs + ns - - case (rho_sgl_screw_neg_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) - cs = cs + ns - - case (rho_sgl_screw_neg_immobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,8) - cs = cs + ns - - case (rho_dip_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2) - cs = cs + ns - - case (excess_rho_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & - - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) & - + (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & - - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) - cs = cs + ns - - case (excess_rho_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & - - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) - cs = cs + ns - - case (excess_rho_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & - - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) - cs = cs + ns - - case (rho_forest_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoForest - cs = cs + ns - - case (delta_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2) + sum(rhoDip,2)) - cs = cs + ns - - case (delta_sgl_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2)) - cs = cs + ns - - case (delta_dip_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(rhoDip,2)) - cs = cs + ns - - case (shearrate_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(gdot,2) - cs = cs + ns - - case (resolvedstress_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = tau - cs = cs + ns - - case (resolvedstress_back_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = tauBack - cs = cs + ns - - case (resolvedstress_external_ID) - do s = 1_pInt,ns - sLattice = slipSystemLattice(s,instance) - constitutive_nonlocal_postResults(cs+s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) - enddo - cs = cs + ns - - case (resistance_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = tauThreshold - cs = cs + ns - - case (rho_dot_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & - + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) & - + sum(rhoDotDip,2) - cs = cs + ns - - case (rho_dot_sgl_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & - + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) - cs = cs + ns - - case (rho_dot_sgl_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) - cs = cs + ns - - case (rho_dot_dip_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) - cs = cs + ns - - case (rho_dot_gen_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,ipc,ip,el) & - + rhoDotMultiplicationOutput(1:ns,2,ipc,ip,el) - cs = cs + ns - - case (rho_dot_gen_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,ipc,ip,el) - cs = cs + ns - - case (rho_dot_gen_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,ipc,ip,el) - cs = cs + ns - - case (rho_dot_sgl2dip_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,ipc,ip,el) & - + rhoDotSingle2DipoleGlideOutput(1:ns,2,ipc,ip,el) - cs = cs + ns - - case (rho_dot_sgl2dip_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,ipc,ip,el) - cs = cs + ns - - case (rho_dot_sgl2dip_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,2,ipc,ip,el) - cs = cs + ns - - case (rho_dot_ann_ath_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,ipc,ip,el) & - + rhoDotAthermalAnnihilationOutput(1:ns,2,ipc,ip,el) - cs = cs + ns - - case (rho_dot_ann_the_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,ipc,ip,el) & - + rhoDotThermalAnnihilationOutput(1:ns,2,ipc,ip,el) - cs = cs + ns - - case (rho_dot_ann_the_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,ipc,ip,el) - cs = cs + ns - - case (rho_dot_ann_the_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,2,ipc,ip,el) - cs = cs + ns - - case (rho_dot_edgejogs_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotEdgeJogsOutput(1:ns,ipc,ip,el) - cs = cs + ns - - case (rho_dot_flux_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,ipc,ip,el),2) - cs = cs + ns - - case (rho_dot_flux_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,ipc,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,5:8,ipc,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) - cs = cs + ns - - case (rho_dot_flux_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,ipc,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,5:6,ipc,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) - cs = cs + ns - - case (rho_dot_flux_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,3:4,ipc,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,7:8,ipc,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) - cs = cs + ns - - case (velocity_edge_pos_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,1) - cs = cs + ns - - case (velocity_edge_neg_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,2) - cs = cs + ns - - case (velocity_screw_pos_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,3) - cs = cs + ns - - case (velocity_screw_neg_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,4) - cs = cs + ns - - case (slipdirectionx_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(1,1:ns,1) - cs = cs + ns - - case (slipdirectiony_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(2,1:ns,1) - cs = cs + ns - - case (slipdirectionz_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(3,1:ns,1) - cs = cs + ns - - case (slipnormalx_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(1,1:ns) - cs = cs + ns - - case (slipnormaly_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(2,1:ns) - cs = cs + ns - - case (slipnormalz_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(3,1:ns) - cs = cs + ns - - case (fluxdensity_edge_posx_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(1,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_posy_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(2,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_posz_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(3,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negx_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(1,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negy_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(2,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negz_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(3,1:ns,1) - cs = cs + ns - - case (fluxdensity_screw_posx_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(1,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_posy_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(2,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_posz_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(3,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negx_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(1,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negy_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(2,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negz_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(3,1:ns,2) - cs = cs + ns - - case (maximumdipoleheight_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1) - cs = cs + ns - - case (maximumdipoleheight_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2) - cs = cs + ns - - case(dislocationstress_ID) - sigma = constitutive_nonlocal_dislocationstress(Fe, ipc, ip, el) - constitutive_nonlocal_postResults(cs+1_pInt) = sigma(1,1) - constitutive_nonlocal_postResults(cs+2_pInt) = sigma(2,2) - constitutive_nonlocal_postResults(cs+3_pInt) = sigma(3,3) - constitutive_nonlocal_postResults(cs+4_pInt) = sigma(1,2) - constitutive_nonlocal_postResults(cs+5_pInt) = sigma(2,3) - constitutive_nonlocal_postResults(cs+6_pInt) = sigma(3,1) - cs = cs + 6_pInt - - case(accumulatedshear_ID) -! constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = state(ipc,ip,el)%p(iGamma(1:ns,instance)) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = & - plasticState(mapping(2,ipc,ip,el))%state(iGamma(1:ns,instance),mapping(1,ipc,ip,el)) - cs = cs + ns - - end select -enddo outputsLoop - -end function constitutive_nonlocal_postResults - -#else - -!!!!!!!!! -!!!!!!!!! -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -pure function constitutive_nonlocal_postResults(Tstar_v,Fe,state,dotState,ipc,ip,el) +function constitutive_nonlocal_postResults(Tstar_v,Fe,ip,el) use math, only: & math_mul6x6, & math_mul33x3, & @@ -4325,6 +3473,8 @@ pure function constitutive_nonlocal_postResults(Tstar_v,Fe,state,dotState,ipc,ip use material, only: & homogenization_maxNgrains, & material_phase, & + mappingConstitutive, & + plasticState, & phase_plasticityInstance, & phase_Noutput use lattice, only: & @@ -4340,55 +3490,52 @@ pure function constitutive_nonlocal_postResults(Tstar_v,Fe,state,dotState,ipc,ip Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & Fe !< elastic deformation gradient - type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - state !< microstructure state - type(p_vec), intent(in) :: & - dotState ! evolution rate of microstructural state integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), dimension(constitutive_nonlocal_sizePostResults(& - phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & constitutive_nonlocal_postResults integer(pInt) :: & - phase, & + ph, & instance, & !< current instance of this plasticity ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation cs, & !< constitutive result index o, & !< index of current output + of,& !< offset shortcut t, & !< type of dislocation s, & !< index of my current slip system sLattice !< index of my current slip system according to lattice order - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) rhoDotSgl !< evolution rate of single dislocation densities (positive/negative screw and edge without dipoles) - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),4) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & gdot, & !< shear rates v !< velocities - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoForest, & !< forest dislocation density tauThreshold, & !< threshold shear stress tau, & !< current resolved shear stress tauBack !< back stress from pileups on same slip system - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),2) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) rhoDotDip, & !< evolution rate of dipole dislocation densities (screw and edge dipoles) dLower, & !< minimum stable dipole distance for edges and screws dUpper !< current maximum stable dipole distance for edges and screws - real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),2) :: & + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,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), dimension(3,totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & n_currentconf !< slip system normal (unit vector) in current configuration real(pReal), dimension(3,3) :: & sigma -phase = material_phase(ipc,ip,el) -instance = phase_plasticityInstance(phase) +ph = mappingConstitutive(2,1,ip,el) +of = mappingConstitutive(1,1,ip,el) +instance = phase_plasticityInstance(ph) ns = totalNslip(instance) cs = 0_pInt @@ -4398,21 +3545,19 @@ constitutive_nonlocal_postResults = 0.0_pReal !* short hand notations for state variables forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = state(ipc,ip,el)%p(iRhoU(s,t,instance)) - rhoSgl(s,t+4_pInt) = state(ipc,ip,el)%p(iRhoB(s,t,instance)) - v(s,t) = state(ipc,ip,el)%p(iV(s,t,instance)) - rhoDotSgl(s,t) = dotState%p(iRhoU(s,t,instance)) - rhoDotSgl(s,t+4_pInt) = dotState%p(iRhoB(s,t,instance)) + rhoSgl(s,t) = plasticState(ph)%State(iRhoU(s,t,instance),of) + rhoSgl(s,t+4_pInt) = plasticState(ph)%State(iRhoB(s,t,instance),of) + v(s,t) = plasticState(ph)%State(iV(s,t,instance),of) + rhoDotSgl(s,t) = plasticState(ph)%dotState(iRhoU(s,t,instance),of) + rhoDotSgl(s,t+4_pInt) = plasticState(ph)%dotState(iRhoB(s,t,instance),of) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = state(ipc,ip,el)%p(iRhoD(s,c,instance)) - rhoDotDip(s,c) = dotState%p(iRhoD(s,c,instance)) + rhoDip(s,c) = plasticState(ph)%State(iRhoD(s,c,instance),of) + rhoDotDip(s,c) = plasticState(ph)%dotState(iRhoD(s,c,instance),of) endforall -rhoForest = state(ipc,ip,el)%p(iRhoF(1:ns,instance)) -tauThreshold = state(ipc,ip,el)%p(iTauF(1:ns,instance)) -tauBack = state(ipc,ip,el)%p(iTauB(1:ns,instance)) - - +rhoForest = plasticState(ph)%State(iRhoF(1:ns,instance),of) +tauThreshold = plasticState(ph)%State(iTauF(1:ns,instance),of) +tauBack = plasticState(ph)%State(iTauB(1:ns,instance),of) !* Calculate shear rate @@ -4424,14 +3569,14 @@ forall (t = 1_pInt:4_pInt) & do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tauBack(s) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - lattice_nu(phase)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) & +dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) where(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+& @@ -4445,13 +3590,13 @@ dUpper = max(dUpper,dLower) !*** dislocation motion -m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),phase) -m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),phase) +m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),ph) +m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),ph) forall (c = 1_pInt:2_pInt, s = 1_pInt:ns) & - m_currentconf(1:3,s,c) = math_mul33x3(Fe(1:3,1:3,ipc,ip,el), m(1:3,s,c)) + m_currentconf(1:3,s,c) = math_mul33x3(Fe(1:3,1:3,1_pInt,ip,el), m(1:3,s,c)) forall (s = 1_pInt:ns) & - n_currentconf(1:3,s) = math_mul33x3(Fe(1:3,1:3,ipc,ip,el), & - lattice_sn(1:3,slipSystemLattice(s,instance),phase)) + n_currentconf(1:3,s) = math_mul33x3(Fe(1:3,1:3,1_pInt,ip,el), & + lattice_sn(1:3,slipSystemLattice(s,instance),ph)) outputsLoop: do o = 1_pInt,Noutput(instance) @@ -4612,7 +3757,7 @@ outputsLoop: do o = 1_pInt,Noutput(instance) case (resolvedstress_external_ID) do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - constitutive_nonlocal_postResults(cs+s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + constitutive_nonlocal_postResults(cs+s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) enddo cs = cs + ns @@ -4640,70 +3785,70 @@ outputsLoop: do o = 1_pInt,Noutput(instance) cs = cs + ns case (rho_dot_gen_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,ipc,ip,el) & - + rhoDotMultiplicationOutput(1:ns,2,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_gen_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) cs = cs + ns case (rho_dot_gen_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_sgl2dip_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,ipc,ip,el) & - + rhoDotSingle2DipoleGlideOutput(1:ns,2,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_sgl2dip_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) cs = cs + ns case (rho_dot_sgl2dip_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,2,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_ath_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,ipc,ip,el) & - + rhoDotAthermalAnnihilationOutput(1:ns,2,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_the_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,ipc,ip,el) & - + rhoDotThermalAnnihilationOutput(1:ns,2,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_the_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_the_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,2,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_edgejogs_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotEdgeJogsOutput(1:ns,ipc,ip,el) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) cs = cs + ns case (rho_dot_flux_mobile_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,ipc,ip,el),2) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) cs = cs + ns case (rho_dot_flux_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,ipc,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,5:8,ipc,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) & + + sum(rhoDotFluxOutput(1:ns,5:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) cs = cs + ns case (rho_dot_flux_edge_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,ipc,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,5:6,ipc,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) & + + sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) cs = cs + ns case (rho_dot_flux_screw_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,3:4,ipc,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,7:8,ipc,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,3:4,1_pInt,ip,el),2) & + + sum(rhoDotFluxOutput(1:ns,7:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) cs = cs + ns case (velocity_edge_pos_ID) @@ -4803,7 +3948,7 @@ outputsLoop: do o = 1_pInt,Noutput(instance) cs = cs + ns case(dislocationstress_ID) - sigma = constitutive_nonlocal_dislocationstress(state, Fe, ipc, ip, el) + sigma = constitutive_nonlocal_dislocationstress(Fe, ip, el) constitutive_nonlocal_postResults(cs+1_pInt) = sigma(1,1) constitutive_nonlocal_postResults(cs+2_pInt) = sigma(2,2) constitutive_nonlocal_postResults(cs+3_pInt) = sigma(3,3) @@ -4813,12 +3958,12 @@ outputsLoop: do o = 1_pInt,Noutput(instance) cs = cs + 6_pInt case(accumulatedshear_ID) - constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = state(ipc,ip,el)%p(iGamma(1:ns,instance)) + constitutive_nonlocal_postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of) cs = cs + ns end select enddo outputsLoop end function constitutive_nonlocal_postResults -#endif + end module constitutive_nonlocal diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 91acb5431..97b59bb39 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -14,10 +14,6 @@ module constitutive_phenopowerlaw implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & -#ifndef NEWSTATE - constitutive_phenopowerlaw_sizeDotState, & - constitutive_phenopowerlaw_sizeState, & -#endif constitutive_phenopowerlaw_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -40,7 +36,6 @@ module constitutive_phenopowerlaw constitutive_phenopowerlaw_gdot0_twin, & !< reference shear strain rate for twin (input parameter) constitutive_phenopowerlaw_n_slip, & !< stress exponent for slip (input parameter) constitutive_phenopowerlaw_n_twin, & !< stress exponent for twin (input parameter) - constitutive_phenopowerlaw_spr, & !< push-up factor for slip saturation due to twinning constitutive_phenopowerlaw_twinB, & constitutive_phenopowerlaw_twinC, & @@ -90,19 +85,13 @@ module constitutive_phenopowerlaw public :: & constitutive_phenopowerlaw_init, & -#ifndef NEWSTATE - constitutive_phenopowerlaw_stateInit, & - constitutive_phenopowerlaw_aTolState, & -#endif constitutive_phenopowerlaw_LpAndItsTangent, & constitutive_phenopowerlaw_dotState, & constitutive_phenopowerlaw_postResults - -#ifdef NEWSTATE private :: & constitutive_phenopowerlaw_aTolState, & constitutive_phenopowerlaw_stateInit -#endif + contains @@ -142,10 +131,8 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) phase_Noutput, & PLASTICITY_PHENOPOWERLAW_label, & PLASTICITY_PHENOPOWERLAW_ID, & - material_phase, & -#ifdef NEWSTATE + material_phase, & plasticState, & -#endif MATERIAL_partPhase use lattice use numerics,only: & @@ -179,11 +166,8 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance -#ifndef NEWSTATE - allocate(constitutive_phenopowerlaw_sizeDotState(maxNinstance), source=0_pInt) - allocate(constitutive_phenopowerlaw_sizeState(maxNinstance), source=0_pInt) -#endif -allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) + + allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) allocate(constitutive_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance), & source=0_pInt) allocate(constitutive_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) @@ -428,6 +412,7 @@ allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), enddo parsingFile sanityChecks: do phase = 1_pInt, size(phase_plasticity) + NofMyPhase=count(material_phase==phase) myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then instance = phase_plasticityInstance(phase) constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance) = & @@ -486,9 +471,12 @@ allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), maxNinstance), source=0.0_pReal) initializeInstances: do phase = 1_pInt, size(phase_plasticity) - if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then + myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then NofMyPhase=count(material_phase==phase) instance = phase_plasticityInstance(phase) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array outputsLoop: do o = 1_pInt,constitutive_phenopowerlaw_Noutput(instance) select case(constitutive_phenopowerlaw_outputID(o,instance)) case(resistance_slip_ID, & @@ -515,15 +503,8 @@ allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), constitutive_phenopowerlaw_sizePostResults(instance) = constitutive_phenopowerlaw_sizePostResults(instance) + mySize endif outputFound enddo outputsLoop - -#ifndef NEWSTATE - constitutive_phenopowerlaw_sizeDotState(instance) = constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)+ & - 2_pInt + & - constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance) ! s_slip, s_twin, sum(gamma), sum(f), accshear_slip, accshear_twin - constitutive_phenopowerlaw_sizeState(instance) = constitutive_phenopowerlaw_sizeDotState(instance) -#else +!-------------------------------------------------------------------------------------------------- +! allocate state arrays sizeState = constitutive_phenopowerlaw_totalNslip(instance)+ & constitutive_phenopowerlaw_totalNtwin(instance)+ & 2_pInt + & @@ -533,24 +514,23 @@ allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), sizeDotState = sizeState plasticState(phase)%sizeDotState = sizeState plasticState(phase)%sizePostResults = constitutive_phenopowerlaw_sizePostResults(instance) - allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0(sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%dotState_backup(sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase),source=0.0_pReal) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) -#endif + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X index_myFamily = sum(constitutive_phenopowerlaw_Nslip(1:f-1_pInt,instance)) do j = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! loop over (active) systems in my family (slip) @@ -601,59 +581,50 @@ allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), enddo; enddo enddo; enddo -#ifdef NEWSTATE call constitutive_phenopowerlaw_stateInit(phase,instance) call constitutive_phenopowerlaw_aTolState(phase,instance) -#endif - endif + endif myPhase2 enddo initializeInstances end subroutine constitutive_phenopowerlaw_init -#ifdef NEWSTATE - !-------------------------------------------------------------------------------------------------- !> @brief sets the initial microstructural state for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -subroutine constitutive_phenopowerlaw_stateInit(phase,instance) +subroutine constitutive_phenopowerlaw_stateInit(ph,instance) use lattice, only: & lattice_maxNslipFamily, & lattice_maxNtwinFamily use material, only: & - plasticState + plasticState, & + mappingConstitutive implicit none integer(pInt), intent(in) :: & instance, & !< number specifying the instance of the plasticity - phase + ph integer(pInt) :: & i - real(pReal), dimension(size(plasticState(phase)%state(:,1))) :: tempState + real(pReal), dimension(plasticState(ph)%sizeState) :: & + tempState - tempState = 0.0_pReal do i = 1_pInt,lattice_maxNslipFamily - tempState(1+& - sum(constitutive_phenopowerlaw_Nslip(1:i-1,instance)) : & - sum(constitutive_phenopowerlaw_Nslip(1:i ,instance))) = & - constitutive_phenopowerlaw_tau0_slip(i,instance) - + tempState(1+sum(constitutive_phenopowerlaw_Nslip(1:i-1,instance)) : & + sum(constitutive_phenopowerlaw_Nslip(1:i ,instance))) = & + constitutive_phenopowerlaw_tau0_slip(i,instance) enddo do i = 1_pInt,lattice_maxNtwinFamily - tempState(1+sum(constitutive_phenopowerlaw_Nslip(:,instance))+& - sum(constitutive_phenopowerlaw_Ntwin(1:i-1,instance)) : & - sum(constitutive_phenopowerlaw_Nslip(:,instance))+& - sum(constitutive_phenopowerlaw_Ntwin(1:i ,instance))) = & - constitutive_phenopowerlaw_tau0_twin(i,instance) - + sum(constitutive_phenopowerlaw_Ntwin(1:i-1,instance)) : & + sum(constitutive_phenopowerlaw_Nslip(:,instance))+& + sum(constitutive_phenopowerlaw_Ntwin(1:i ,instance))) = & + constitutive_phenopowerlaw_tau0_twin(i,instance) enddo -plasticState(phase)%state = spread(tempState,2,size(plasticState(phase)%state(1,:))) -plasticState(phase)%state0 = plasticState(phase)%state -plasticState(phase)%partionedState0 = plasticState(phase)%state + plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state0(1,:))) end subroutine constitutive_phenopowerlaw_stateInit @@ -662,107 +633,37 @@ end subroutine constitutive_phenopowerlaw_stateInit !-------------------------------------------------------------------------------------------------- !> @brief sets the relevant state values for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -subroutine constitutive_phenopowerlaw_aTolState(phase,instance) +subroutine constitutive_phenopowerlaw_aTolState(ph,instance) use material, only: & plasticState implicit none integer(pInt), intent(in) :: & instance, & !< number specifying the instance of the plasticity - phase - real(pReal), dimension(size(plasticState(phase)%aTolState(:))) :: tempTol + ph - tempTol = 0.0_pReal + plasticState(ph)%aTolState(1:constitutive_phenopowerlaw_totalNslip(instance)+ & + constitutive_phenopowerlaw_totalNtwin(instance)) = & + constitutive_phenopowerlaw_aTolResistance(instance) + plasticState(ph)%aTolState(1+constitutive_phenopowerlaw_totalNslip(instance)+ & + constitutive_phenopowerlaw_totalNtwin(instance)) = & + constitutive_phenopowerlaw_aTolShear(instance) + plasticState(ph)%aTolState(2+constitutive_phenopowerlaw_totalNslip(instance)+ & + constitutive_phenopowerlaw_totalNtwin(instance)) = & + constitutive_phenopowerlaw_aTolTwinFrac(instance) + plasticState(ph)%aTolState(3+constitutive_phenopowerlaw_totalNslip(instance)+ & + constitutive_phenopowerlaw_totalNtwin(instance): & + 2+2*(constitutive_phenopowerlaw_totalNslip(instance)+ & + constitutive_phenopowerlaw_totalNtwin(instance))) = & + constitutive_phenopowerlaw_aTolShear(instance) - tempTol(1:constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)) = & - constitutive_phenopowerlaw_aTolResistance(instance) - tempTol(1+constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)) = & - constitutive_phenopowerlaw_aTolShear(instance) - tempTol(2+constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)) = & - constitutive_phenopowerlaw_aTolTwinFrac(instance) - tempTol(3+constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance): & - 2+2*(constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance))) = & - constitutive_phenopowerlaw_aTolShear(instance) - - plasticState(phase)%aTolState = tempTol end subroutine constitutive_phenopowerlaw_aTolState -#else -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -pure function constitutive_phenopowerlaw_stateInit(instance) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily - - implicit none - integer(pInt), intent(in) :: & - instance !< number specifying the instance of the plasticity - real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(instance)) :: & - constitutive_phenopowerlaw_stateInit - integer(pInt) :: & - i - - constitutive_phenopowerlaw_stateInit = 0.0_pReal - - do i = 1_pInt,lattice_maxNslipFamily - constitutive_phenopowerlaw_stateInit(1+& - sum(constitutive_phenopowerlaw_Nslip(1:i-1,instance)) : & - sum(constitutive_phenopowerlaw_Nslip(1:i ,instance))) = & - constitutive_phenopowerlaw_tau0_slip(i,instance) - enddo - - do i = 1_pInt,lattice_maxNtwinFamily - constitutive_phenopowerlaw_stateInit(1+sum(constitutive_phenopowerlaw_Nslip(:,instance))+& - sum(constitutive_phenopowerlaw_Ntwin(1:i-1,instance)) : & - sum(constitutive_phenopowerlaw_Nslip(:,instance))+& - sum(constitutive_phenopowerlaw_Ntwin(1:i ,instance))) = & - constitutive_phenopowerlaw_tau0_twin(i,instance) - enddo - -end function constitutive_phenopowerlaw_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -pure function constitutive_phenopowerlaw_aTolState(instance) - - implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - - real(pReal), dimension(constitutive_phenopowerlaw_sizeState(instance)) :: & - constitutive_phenopowerlaw_aTolState - - constitutive_phenopowerlaw_aTolState(1:constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)) = & - constitutive_phenopowerlaw_aTolResistance(instance) - constitutive_phenopowerlaw_aTolState(1+constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)) = & - constitutive_phenopowerlaw_aTolShear(instance) - constitutive_phenopowerlaw_aTolState(2+constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)) = & - constitutive_phenopowerlaw_aTolTwinFrac(instance) - constitutive_phenopowerlaw_aTolState(3+constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance): & - 2+2*(constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance))) = & - constitutive_phenopowerlaw_aTolShear(instance) - -end function constitutive_phenopowerlaw_aTolState - -#endif !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,state,ipc,ip,el) +subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) use prec, only: & p_vec use math, only: & @@ -784,6 +685,8 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar use material, only: & homogenization_maxNgrains, & material_phase, & + plasticState, & + mappingConstitutive, & phase_plasticityInstance implicit none @@ -799,19 +702,13 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state -#else - type(p_vec), intent(in) :: & - state !< microstructure state -#endif - integer(pInt) :: & instance, & nSlip, & nTwin,phase,index_Gamma,index_F,index_myFamily, & - f,i,j,k,l,m,n + f,i,j,k,l,m,n, & + of, & + ph real(pReal), dimension(3,3,3,3) :: & dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & @@ -822,8 +719,9 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar gdot_twin,dgdot_dtautwin,tau_twin - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) nSlip = constitutive_phenopowerlaw_totalNslip(instance) nTwin = constitutive_phenopowerlaw_totalNtwin(instance) index_Gamma = nSlip + nTwin + 1_pInt @@ -835,49 +733,37 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt !-------------------------------------------------------------------------------------------------- ! Calculation of Lp - tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) + tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg(j) = tau_slip_pos(j) - nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) + nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,lattice_NnonSchmid(phase) + do k = 1,lattice_NnonSchmid(ph) tau_slip_pos(j) = tau_slip_pos(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) tau_slip_neg(j) = tau_slip_neg(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,phase) + lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,phase) + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo -#ifdef NEWSTATE gdot_slip_pos(j) = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* & - ((abs(tau_slip_pos(j))/state(j))**constitutive_phenopowerlaw_n_slip(instance))*& + ((abs(tau_slip_pos(j))/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))*& sign(1.0_pReal,tau_slip_pos(j)) gdot_slip_neg(j) = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* & - ((abs(tau_slip_neg(j))/state(j))**constitutive_phenopowerlaw_n_slip(instance))*& + ((abs(tau_slip_neg(j))/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))*& sign(1.0_pReal,tau_slip_neg(j)) - Lp = Lp + (1.0_pReal-state(index_F))*& ! 1-F - (gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) -#else - gdot_slip_pos(j) = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* & - ((abs(tau_slip_pos(j))/state%p(j))**constitutive_phenopowerlaw_n_slip(instance))*& - sign(1.0_pReal,tau_slip_pos(j)) + Lp = Lp + (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + (gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) - gdot_slip_neg(j) = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* & - ((abs(tau_slip_neg(j))/state%p(j))**constitutive_phenopowerlaw_n_slip(instance))*& - sign(1.0_pReal,tau_slip_neg(j)) - - Lp = Lp + (1.0_pReal-state%p(index_F))*& ! 1-F - (gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) -#endif !-------------------------------------------------------------------------------------------------- ! Calculation of the tangent of Lp @@ -885,7 +771,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar dgdot_dtauslip_pos(j) = gdot_slip_pos(j)*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_pos(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtauslip_pos(j)*lattice_Sslip(k,l,1,index_myFamily+i,phase)* & + dgdot_dtauslip_pos(j)*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & nonSchmid_tensor(m,n,1) endif @@ -893,7 +779,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar dgdot_dtauslip_neg(j) = gdot_slip_neg(j)*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_neg(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtauslip_neg(j)*lattice_Sslip(k,l,1,index_myFamily+i,phase)* & + dgdot_dtauslip_neg(j)*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & nonSchmid_tensor(m,n,2) endif enddo @@ -901,25 +787,18 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt !-------------------------------------------------------------------------------------------------- ! Calculation of Lp - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) -#ifdef NEWSTATE - gdot_twin(j) = (1.0_pReal-state(index_F))*& ! 1-F + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F constitutive_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau_twin(j))/state(nSlip+j))**& - constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) -#else - gdot_twin(j) = (1.0_pReal-state%p(index_F))*& ! 1-F - constitutive_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau_twin(j))/state%p(nSlip+j))**& - constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) -#endif - Lp = Lp + gdot_twin(j)*lattice_Stwin(1:3,1:3,index_myFamily+i,phase) + (abs(tau_twin(j))/plasticState(ph)%state(nSlip+j,of))**& + constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) + Lp = Lp + gdot_twin(j)*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) !-------------------------------------------------------------------------------------------------- ! Calculation of the tangent of Lp @@ -927,23 +806,21 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar dgdot_dtautwin(j) = gdot_twin(j)*constitutive_phenopowerlaw_n_twin(instance)/tau_twin(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtautwin(j)*lattice_Stwin(k,l,index_myFamily+i,phase)* & - lattice_Stwin(m,n,index_myFamily+i,phase) + dgdot_dtautwin(j)*lattice_Stwin(k,l,index_myFamily+i,ph)* & + lattice_Stwin(m,n,index_myFamily+i,ph) endif enddo enddo twinFamiliesLoop dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) -end subroutine constitutive_phenopowerlaw_LpAndItsTangent +end subroutine constitutive_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) - use prec, only: & - p_vec +subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & @@ -959,6 +836,8 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) use material, only: & homogenization_maxNgrains, & material_phase, & + mappingConstitutive, & + plasticState, & phase_plasticityInstance implicit none @@ -968,25 +847,14 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element !< microstructure state -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - constitutive_phenopowerlaw_dotState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - constitutive_phenopowerlaw_dotState -#endif - integer(pInt) :: & - instance,phase, & + instance,ph, & nSlip,nTwin, & f,i,j,k, & index_Gamma,index_F,index_myFamily, & - offset_accshear_slip,offset_accshear_twin + offset_accshear_slip,offset_accshear_twin, & + of real(pReal) :: & c_SlipSlip,c_SlipTwin,c_TwinSlip,c_TwinTwin, & ssat_offset @@ -995,8 +863,10 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) gdot_slip,tau_slip_pos,tau_slip_neg,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,tau_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) nSlip = constitutive_phenopowerlaw_totalNslip(instance) nTwin = constitutive_phenopowerlaw_totalNtwin(instance) @@ -1005,89 +875,58 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) index_F = nSlip + nTwin + 2_pInt offset_accshear_slip = nSlip + nTwin + 2_pInt offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip - - constitutive_phenopowerlaw_dotState = 0.0_pReal + plasticState(ph)%dotState = 0.0_pReal + !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices -#ifdef NEWSTATE c_SlipSlip = constitutive_phenopowerlaw_h0_SlipSlip(instance)*& - (1.0_pReal + constitutive_phenopowerlaw_twinC(instance)*state(index_F)**& + (1.0_pReal + constitutive_phenopowerlaw_twinC(instance)*plasticState(ph)%state(index_F,of)**& constitutive_phenopowerlaw_twinB(instance)) c_SlipTwin = 0.0_pReal c_TwinSlip = constitutive_phenopowerlaw_h0_TwinSlip(instance)*& - state(index_Gamma)**constitutive_phenopowerlaw_twinE(instance) + plasticState(ph)%state(index_Gamma,of)**constitutive_phenopowerlaw_twinE(instance) c_TwinTwin = constitutive_phenopowerlaw_h0_TwinTwin(instance)*& - state(index_F)**constitutive_phenopowerlaw_twinD(instance) -#else - c_SlipSlip = constitutive_phenopowerlaw_h0_SlipSlip(instance)*& - (1.0_pReal + constitutive_phenopowerlaw_twinC(instance)*state%p(index_F)**& - constitutive_phenopowerlaw_twinB(instance)) - c_SlipTwin = 0.0_pReal - c_TwinSlip = constitutive_phenopowerlaw_h0_TwinSlip(instance)*& - state%p(index_Gamma)**constitutive_phenopowerlaw_twinE(instance) - c_TwinTwin = constitutive_phenopowerlaw_h0_TwinTwin(instance)*& - state%p(index_F)**constitutive_phenopowerlaw_twinD(instance) -#endif + plasticState(ph)%state(index_F,of)**constitutive_phenopowerlaw_twinD(instance) + !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas -#ifdef NEWSTATE - ssat_offset = constitutive_phenopowerlaw_spr(instance)*sqrt(state(index_F)) -#else - ssat_offset = constitutive_phenopowerlaw_spr(instance)*sqrt(state%p(index_F)) !< microstructure state -#endif + ssat_offset = constitutive_phenopowerlaw_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) j = 0_pInt slipFamiliesLoop1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part -#ifdef NEWSTATE - - right_SlipSlip(j) = abs(1.0_pReal-state(j) / & + right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & (constitutive_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & **constitutive_phenopowerlaw_a_slip(instance)& - *sign(1.0_pReal,1.0_pReal-state(j) / & + *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & (constitutive_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) -#else - right_SlipSlip(j) = abs(1.0_pReal-state%p(j) / & - (constitutive_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & - **constitutive_phenopowerlaw_a_slip(instance)& - *sign(1.0_pReal,1.0_pReal-state%p(j) / & - (constitutive_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) !< microstructure state -#endif right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma - tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) + tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg(j) = tau_slip_pos(j) - do k = 1,lattice_NnonSchmid(phase) + do k = 1,lattice_NnonSchmid(ph) tau_slip_pos(j) = tau_slip_pos(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) tau_slip_neg(j) = tau_slip_neg(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo -#ifdef NEWSTATE - gdot_slip(j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos(j))/state(j))**constitutive_phenopowerlaw_n_slip(instance) & - +(abs(tau_slip_neg(j))/state(j))**constitutive_phenopowerlaw_n_slip(instance))& + ((abs(tau_slip_pos(j))/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg(j))/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))& *sign(1.0_pReal,tau_slip_pos(j)) -#else - gdot_slip(j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos(j))/state%p(j))**constitutive_phenopowerlaw_n_slip(instance) & - +(abs(tau_slip_neg(j))/state%p(j))**constitutive_phenopowerlaw_n_slip(instance))& - *sign(1.0_pReal,tau_slip_pos(j)) -#endif enddo enddo slipFamiliesLoop1 j = 0_pInt twinFamiliesLoop1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt left_TwinSlip(j) = 1.0_pReal ! no system-dependent right part @@ -1097,18 +936,11 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) -#ifdef NEWSTATE - gdot_twin(j) = (1.0_pReal-state(index_F))*& ! 1-F + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F constitutive_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau_twin(j))/state(nSlip+j))**& + (abs(tau_twin(j))/plasticState(ph)%state(nslip+j,of))**& constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) -#else - gdot_twin(j) = (1.0_pReal-state%p(index_F))*& ! 1-F - constitutive_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau_twin(j))/state%p(nSlip+j))**& - constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) -#endif enddo enddo twinFamiliesLoop1 @@ -1118,54 +950,45 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) slipFamiliesLoop2: do f = 1_pInt,lattice_maxNslipFamily do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt - constitutive_phenopowerlaw_dotState(j) = & ! evolution of slip resistance j + plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & dot_product(constitutive_phenopowerlaw_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_SlipTwin * left_SlipTwin(j) * & dot_product(constitutive_phenopowerlaw_hardeningMatrix_SlipTwin(j,1:nTwin,instance), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - constitutive_phenopowerlaw_dotState(index_Gamma) = constitutive_phenopowerlaw_dotState(index_Gamma) + & + plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & abs(gdot_slip(j)) - constitutive_phenopowerlaw_dotState(offset_accshear_slip+j) = abs(gdot_slip(j)) + plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) enddo enddo slipFamiliesLoop2 j = 0_pInt twinFamiliesLoop2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt - constitutive_phenopowerlaw_dotState(j+nSlip) = & ! evolution of twin resistance j + plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & dot_product(constitutive_phenopowerlaw_hardeningMatrix_TwinSlip(j,1:nSlip,instance), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & dot_product(constitutive_phenopowerlaw_hardeningMatrix_TwinTwin(j,1:nTwin,instance), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor -#ifndef NEWSTATE - if (state%p(index_F) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - constitutive_phenopowerlaw_dotState(index_F) = constitutive_phenopowerlaw_dotState(index_F) + & - gdot_twin(j)/lattice_shearTwin(index_myFamily+i,phase) -#else - if (state(index_F) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - constitutive_phenopowerlaw_dotState(index_F) = constitutive_phenopowerlaw_dotState(index_F) + & - gdot_twin(j)/lattice_shearTwin(index_myFamily+i,phase) -#endif - - - - constitutive_phenopowerlaw_dotState(offset_accshear_twin+j) = abs(gdot_twin(j)) + if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) + plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) enddo enddo twinFamiliesLoop2 -end function constitutive_phenopowerlaw_dotState +end subroutine constitutive_phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) +function constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) use prec, only: & p_vec use mesh, only: & @@ -1174,6 +997,8 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) use material, only: & homogenization_maxNgrains, & material_phase, & + plasticState, & + mappingConstitutive, & phase_plasticityInstance, & phase_Noutput use lattice, only: & @@ -1195,27 +1020,21 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element !< microstructure state -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state -#else - type(p_vec), intent(in) :: & - state !< microstructure state -#endif real(pReal), dimension(constitutive_phenopowerlaw_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & constitutive_phenopowerlaw_postResults integer(pInt) :: & - instance,phase, & + instance,ph, of, & nSlip,nTwin, & o,f,i,c,j,k, & index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) nSlip = constitutive_phenopowerlaw_totalNslip(instance) nTwin = constitutive_phenopowerlaw_totalNtwin(instance) @@ -1231,48 +1050,33 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) outputsLoop: do o = 1_pInt,constitutive_phenopowerlaw_Noutput(instance) select case(constitutive_phenopowerlaw_outputID(o,instance)) case (resistance_slip_ID) -#ifdef NEWSTATE - constitutive_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(1:nSlip) -#else - constitutive_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state%p(1:nSlip) -#endif + constitutive_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) c = c + nSlip case (accumulatedshear_slip_ID) -#ifdef NEWSTATE - constitutive_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(index_accshear_slip:& - index_accshear_slip+nSlip-1_pInt) -#else - constitutive_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state%p(index_accshear_slip:& - index_accshear_slip+nSlip-1_pInt) -#endif + constitutive_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& + index_accshear_slip+nSlip-1_pInt,of) c = c + nSlip case (shearrate_slip_ID) j = 0_pInt slipFamiliesLoop1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos - do k = 1,lattice_NnonSchmid(phase) + do k = 1,lattice_NnonSchmid(ph) tau_slip_pos = tau_slip_pos + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo -#ifdef NEWSTATE constitutive_phenopowerlaw_postResults(c+j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/state(j))**constitutive_phenopowerlaw_n_slip(instance) & - +(abs(tau_slip_neg)/state(j))**constitutive_phenopowerlaw_n_slip(instance))& + ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))& *sign(1.0_pReal,tau_slip_pos) -#else - constitutive_phenopowerlaw_postResults(c+j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/state%p(j))**constitutive_phenopowerlaw_n_slip(instance) & - +(abs(tau_slip_neg)/state%p(j))**constitutive_phenopowerlaw_n_slip(instance))& - *sign(1.0_pReal,tau_slip_pos) -#endif + enddo enddo slipFamiliesLoop1 c = c + nSlip @@ -1280,63 +1084,40 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt slipFamiliesLoop2: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt constitutive_phenopowerlaw_postResults(c+j) = & - dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) enddo enddo slipFamiliesLoop2 c = c + nSlip case (totalshear_ID) -#ifdef NEWSTATE constitutive_phenopowerlaw_postResults(c+1_pInt) = & - state(index_Gamma) -#else - constitutive_phenopowerlaw_postResults(c+1_pInt) = & - state%p(index_Gamma) -#endif + plasticState(ph)%state(index_Gamma,of) c = c + 1_pInt case (resistance_twin_ID) -#ifdef NEWSTATE constitutive_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(1_pInt+nSlip:nTwin+nSlip-1_pInt) -#else - constitutive_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state%p(1_pInt+nSlip:nTwin+nSlip-1_pInt) -#endif + plasticState(ph)%state(1_pInt+nSlip:nTwin+nSlip-1_pInt,of) c = c + nTwin case (accumulatedshear_twin_ID) -#ifdef NEWSTATE constitutive_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt) -#else - constitutive_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state%p(index_accshear_twin:index_accshear_twin+nTwin-1_pInt) -#endif + plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) c = c + nTwin - case (shearrate_twin_ID) j = 0_pInt twinFamiliesLoop1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j + 1_pInt - tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) -#ifdef NEWSTATE - constitutive_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(index_F))*& ! 1-F + tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + constitutive_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F constitutive_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau)/state(j+nSlip))**& + (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) -#else - constitutive_phenopowerlaw_postResults(c+j) = (1.0_pReal-state%p(index_F))*& ! 1-F - constitutive_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau)/state%p(j+nSlip))**& - constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) -#endif enddo enddo twinFamiliesLoop1 c = c + nTwin @@ -1344,21 +1125,17 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) case (resolvedstress_twin_ID) j = 0_pInt twinFamiliesLoop2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j + 1_pInt constitutive_phenopowerlaw_postResults(c+j) = & - dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) + dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) enddo enddo twinFamiliesLoop2 c = c + nTwin case (totalvolfrac_ID) -#ifdef NEWSTATE - constitutive_phenopowerlaw_postResults(c+1_pInt) = state(index_F) -#else - constitutive_phenopowerlaw_postResults(c+1_pInt) = state%p(index_F) -#endif + constitutive_phenopowerlaw_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) c = c + 1_pInt end select @@ -1366,6 +1143,4 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) end function constitutive_phenopowerlaw_postResults - - end module constitutive_phenopowerlaw diff --git a/code/constitutive_thermal.f90 b/code/constitutive_thermal.f90 index cf3d0111f..3b80e7b76 100644 --- a/code/constitutive_thermal.f90 +++ b/code/constitutive_thermal.f90 @@ -19,7 +19,6 @@ module constitutive_thermal constitutive_thermal_init, & constitutive_thermal_microstructure, & constitutive_thermal_collectDotState, & - constitutive_thermal_collectDeltaState, & constitutive_thermal_postResults contains @@ -204,28 +203,6 @@ subroutine constitutive_thermal_collectDotState(Tstar_v, Lp, ipc, ip, el) end subroutine constitutive_thermal_collectDotState -!-------------------------------------------------------------------------------------------------- -!> @brief for constitutive models having an instantaneous change of state (so far, only nonlocal) -!> will return false if delta state is not needed/supported by the constitutive model -!-------------------------------------------------------------------------------------------------- -logical function constitutive_thermal_collectDeltaState(ipc, ip, el) - use material, only: & - material_phase, & - phase_thermal - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - - select case (phase_thermal(material_phase(ipc,ip,el))) - - end select - -end function constitutive_thermal_collectDeltaState - - !-------------------------------------------------------------------------------------------------- !> @brief returns array of constitutive results !-------------------------------------------------------------------------------------------------- diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90 index 2604b35f0..c1fd23982 100644 --- a/code/constitutive_titanmod.f90 +++ b/code/constitutive_titanmod.f90 @@ -34,8 +34,6 @@ module constitutive_titanmod integer(pInt), dimension(:), allocatable, public, protected :: & - constitutive_titanmod_sizeState, & !< total number of microstructural state variables - constitutive_titanmod_sizeDotState, & !< number of dotStates constitutive_titanmod_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -179,9 +177,7 @@ module constitutive_titanmod constitutive_titanmod_LpAndItsTangent, & constitutive_titanmod_dotState, & constitutive_titanmod_postResults, & - constitutive_titanmod_homogenizedC, & - constitutive_titanmod_aTolState - + constitutive_titanmod_homogenizedC contains @@ -219,15 +215,11 @@ subroutine constitutive_titanmod_init(fileUnit) phase_Noutput, & PLASTICITY_TITANMOD_label, & PLASTICITY_TITANMOD_ID, & -#ifdef NEWSTATE plasticState, & -#endif MATERIAL_partPhase use lattice -#ifdef NEWSTATE use numerics,only: & numerics_integrator -#endif implicit none integer(pInt), intent(in) :: fileUnit @@ -245,9 +237,7 @@ subroutine constitutive_titanmod_init(fileUnit) Nchunks_SlipFamilies, Nchunks_TwinFamilies, & mySize, & maxTotalNslip,maxTotalNtwin, maxNinstance -#ifdef NEWSTATE integer(pInt) :: sizeState, sizeDotState -#endif integer(pInt) :: NofMyPhase character(len=65536) :: & tag = '', & @@ -264,8 +254,6 @@ subroutine constitutive_titanmod_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(constitutive_titanmod_sizeDotState(maxNinstance), source=0_pInt) - allocate(constitutive_titanmod_sizeState(maxNinstance), source=0_pInt) allocate(constitutive_titanmod_sizePostResults(maxNinstance), source=0_pInt) allocate(constitutive_titanmod_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) allocate(constitutive_titanmod_output(maxval(phase_Noutput),maxNinstance)) @@ -812,26 +800,16 @@ subroutine constitutive_titanmod_init(fileUnit) enddo; enddo !-------------------------------------------------------------------------------------------------- -! determine size of state array +! determine size of state array ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) - constitutive_titanmod_sizeDotState(instance) = & - size(constitutive_titanmod_listBasicSlipStates)*ns + & - size(constitutive_titanmod_listBasicTwinStates)*nt - constitutive_titanmod_sizeState(instance) = & - constitutive_titanmod_sizeDotState(instance)+ & - size(constitutive_titanmod_listDependentSlipStates)*ns + & - size(constitutive_titanmod_listDependentTwinStates)*nt -#ifdef NEWSTATE sizeDotState = & size(constitutive_titanmod_listBasicSlipStates)*ns + & size(constitutive_titanmod_listBasicTwinStates)*nt - sizeState = & - constitutive_titanmod_sizeDotState(instance)+ & + sizeState = sizeDotState+ & size(constitutive_titanmod_listDependentSlipStates)*ns + & size(constitutive_titanmod_listDependentTwinStates)*nt -#endif !-------------------------------------------------------------------------------------------------- ! determine size of postResults array @@ -865,12 +843,11 @@ subroutine constitutive_titanmod_init(fileUnit) constitutive_titanmod_sizePostResults(instance) = constitutive_titanmod_sizePostResults(instance) + mySize endif outputFound enddo outputsLoop -#ifdef NEWSTATE ! Determine size of state array plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizePostResults = constitutive_titanmod_sizePostResults(instance) - allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) + allocate(plasticState(phase)%aTolState (sizeState), source=constitutive_titanmod_aTolRho(instance)) allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -888,7 +865,6 @@ subroutine constitutive_titanmod_init(fileUnit) allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (any(numerics_integrator == 5_pInt)) & allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) -#endif !-------------------------------------------------------------------------------------------------- ! construction of the twin elasticity matrices do j=1_pInt,lattice_maxNtwinFamily @@ -1070,7 +1046,7 @@ subroutine constitutive_titanmod_init(fileUnit) abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,instance),phase), & lattice_td(:,constitutive_titanmod_twinSystemLattice(t2,instance),phase))) enddo; enddo - + call constitutive_titanmod_stateInit(phase,instance) endif enddo initializeInstances @@ -1080,19 +1056,19 @@ end subroutine constitutive_titanmod_init !-------------------------------------------------------------------------------------------------- !> @brief sets the initial microstructural state for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE -subroutine constitutive_titanmod_stateInit(instance,phase) +subroutine constitutive_titanmod_stateInit(ph,instance) use lattice, only: & lattice_maxNslipFamily, & lattice_maxNtwinFamily, & lattice_mu use material, only: & - plasticState + plasticState, & + mappingConstitutive implicit none integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - integer(pInt), intent(in) :: phase !< number specifying the phase of the plasticity + integer(pInt), intent(in) :: ph !< number specifying the phase of the plasticity integer(pInt) :: & @@ -1110,7 +1086,7 @@ subroutine constitutive_titanmod_stateInit(instance,phase) real(pReal), dimension(constitutive_titanmod_totalNtwin(instance)) :: & twingamma_dot0, & resistance_twin0 - real(pReal), dimension(plasticState(phase)%sizeState) :: tempState + real(pReal), dimension(plasticState(ph)%sizeState) :: tempState !!!!!!!!!????????? check ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) @@ -1150,11 +1126,11 @@ subroutine constitutive_titanmod_stateInit(instance,phase) sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,instance))+ & dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,instance))) resistance_edge0(s) = & - lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & + lattice_mu(ph)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & dot_product((rho_screw0),constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))) resistance_screw0(s) = & - lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & + lattice_mu(ph)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))+ & dot_product((rho_screw0), constitutive_titanmod_interactionMatrix_ss(1:ns,s,instance))) end forall @@ -1172,142 +1148,14 @@ tempState (4_pInt*ns+nt+1_pInt:5_pInt*ns+nt) = segment_screw0 tempState (5_pInt*ns+nt+1_pInt:6_pInt*ns+nt) = resistance_edge0 tempState (6_pInt*ns+nt+1_pInt:7_pInt*ns+nt) = resistance_screw0 tempState (7_pInt*ns+nt+1_pInt:7_pInt*ns+2_pInt*nt)=resistance_twin0 - + +plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) end subroutine constitutive_titanmod_stateInit -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_titanmod_aTolState(phase,instance) -use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & - phase -! real(pReal), dimension(size(plasticState(phase)%aTolState(:))) :: tempTol - real(pReal), dimension(plasticState(phase)%sizeState) :: tempTol - - tempTol = 0.0_pReal - tempTol = constitutive_titanmod_aTolRho(instance) - -end subroutine constitutive_titanmod_aTolState - -#else - -pure function constitutive_titanmod_stateInit(instance,phase) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_mu - - implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - integer(pInt), intent(in) :: phase !< number specifying the phase of the plasticity - real(pReal), dimension(constitutive_titanmod_sizeState(instance)) :: & - constitutive_titanmod_stateInit - - integer(pInt) :: & - s,s0,s1, & - t,t0,t1, & - ns,nt,f - real(pReal), dimension(constitutive_titanmod_totalNslip(instance)) :: & - rho_edge0, & - rho_screw0, & - shear_system0, & - segment_edge0, & - segment_screw0, & - resistance_edge0, & - resistance_screw0 - real(pReal), dimension(constitutive_titanmod_totalNtwin(instance)) :: & - twingamma_dot0, & - resistance_twin0 - - ns = constitutive_titanmod_totalNslip(instance) - nt = constitutive_titanmod_totalNtwin(instance) - - -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables for slip - s1 = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - s0 = s1 + 1_pInt - s1 = s0 + constitutive_titanmod_Nslip(f,instance) - 1_pInt - do s = s0,s1 - rho_edge0(s) = constitutive_titanmod_rho_edge0(f,instance) - rho_screw0(s) = constitutive_titanmod_rho_screw0(f,instance) - shear_system0(s) = 0.0_pReal - enddo - enddo - -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables for twin - t1 = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily - t0 = t1 + 1_pInt - t1 = t0 + constitutive_titanmod_Ntwin(f,instance) - 1_pInt - do t = t0,t1 - twingamma_dot0(t)=0.0_pReal - enddo - enddo - -!-------------------------------------------------------------------------------------------------- -! initialize dependent slip microstructural variables - forall (s = 1_pInt:ns) - segment_edge0(s) = constitutive_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,instance))) - segment_screw0(s) = constitutive_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,instance))) - resistance_edge0(s) = & - lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & - sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & - dot_product((rho_screw0),constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))) - resistance_screw0(s) = & - lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & - sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))+ & - dot_product((rho_screw0), constitutive_titanmod_interactionMatrix_ss(1:ns,s,instance))) - end forall - - forall (t = 1_pInt:nt) & - resistance_twin0(t) = 0.0_pReal - - constitutive_titanmod_stateInit = 0.0_pReal - constitutive_titanmod_stateInit(1:ns) = rho_edge0 - constitutive_titanmod_stateInit(1_pInt*ns+1_pInt:2_pInt*ns) = rho_screw0 - constitutive_titanmod_stateInit(2_pInt*ns+1_pInt:3_pInt*ns) = shear_system0 - constitutive_titanmod_stateInit(3_pInt*ns+1_pInt:3_pInt*ns+nt) = twingamma_dot0 - constitutive_titanmod_stateInit(3_pInt*ns+nt+1_pInt:4_pInt*ns+nt) = segment_edge0 - constitutive_titanmod_stateInit(4_pInt*ns+nt+1_pInt:5_pInt*ns+nt) = segment_screw0 - constitutive_titanmod_stateInit(5_pInt*ns+nt+1_pInt:6_pInt*ns+nt) = resistance_edge0 - constitutive_titanmod_stateInit(6_pInt*ns+nt+1_pInt:7_pInt*ns+nt) = resistance_screw0 - constitutive_titanmod_stateInit(7_pInt*ns+nt+1_pInt:7_pInt*ns+2_pInt*nt)=resistance_twin0 - -end function constitutive_titanmod_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -pure function constitutive_titanmod_aTolState(instance) - - implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - - real(pReal), dimension(constitutive_titanmod_sizeState(instance)) :: & - constitutive_titanmod_aTolState - - constitutive_titanmod_aTolState = constitutive_titanmod_aTolRho(instance) - -end function constitutive_titanmod_aTolState - -#endif !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- -pure function constitutive_titanmod_homogenizedC(state,ipc,ip,el) +function constitutive_titanmod_homogenizedC(ipc,ip,el) use prec, only: & p_vec use mesh, only: & @@ -1316,7 +1164,9 @@ pure function constitutive_titanmod_homogenizedC(state,ipc,ip,el) use material, only: & homogenization_maxNgrains, & material_phase, & - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive use lattice, only: & lattice_C66 @@ -1327,51 +1177,37 @@ implicit none ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & volumefraction_PerTwinSys integer(pInt) :: & - phase, & + ph, & + of, & instance, & ns, nt, & i real(pReal) :: & sumf - tempState = 0.0_pReal -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif !-------------------------------------------------------------------------------------------------- ! shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) +! ph = material_phase(ipc,ip,el) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) !-------------------------------------------------------------------------------------------------- ! total twin volume fraction do i=1_pInt,nt - volumefraction_PerTwinSys(i)=tempState(3_pInt*ns+i)/ & + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & constitutive_titanmod_twinshearconstant_PerTwinSys(i,instance) enddo sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 !-------------------------------------------------------------------------------------------------- ! homogenized elasticity matrix - constitutive_titanmod_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,phase) + constitutive_titanmod_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,ph) do i=1_pInt,nt constitutive_titanmod_homogenizedC = constitutive_titanmod_homogenizedC & + volumefraction_PerTwinSys(i)*& @@ -1384,16 +1220,17 @@ end function constitutive_titanmod_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) - use prec, only: & - p_vec +subroutine constitutive_titanmod_microstructure(temperature,ipc,ip,el) + use mesh, only: & mesh_NcpElems, & mesh_maxNips use material, only: & homogenization_maxNgrains, & material_phase,& - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive use lattice, only: & lattice_mu @@ -1404,22 +1241,12 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) el !< element real(pReal), intent(in) :: & temperature !< temperature at IP -#ifdef NEWSTATE - real(pReal), dimension(:), intent(inout) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(inout) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif - integer(pInt) :: & instance, & ns, nt, s, t, & - i, phase + i, & + ph, & + of real(pReal) :: & sumf, & sfe ! stacking fault energy @@ -1427,22 +1254,19 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) volumefraction_PerTwinSys !-------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif !Shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) !-------------------------------------------------------------------------------------------------- ! total twin volume fraction forall (i = 1_pInt:nt) & - volumefraction_PerTwinSys(i)=tempState(3_pInt*ns+i)/ & + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & constitutive_titanmod_twinshearconstant_PerTwinSys(i,instance) sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 @@ -1452,59 +1276,54 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! average segment length for edge dislocations in matrix forall (s = 1_pInt:ns) & - tempState(3_pInt*ns+nt+s) = constitutive_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product(tempState(1:ns), & + plasticState(ph)%state(3_pInt*ns+nt+s, of) = constitutive_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & + sqrt(dot_product(plasticState(ph)%state(1:ns, of), & constitutive_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product(tempState(ns+1_pInt:2_pInt*ns), & + dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & constitutive_titanmod_forestProjectionScrew(1:ns,s,instance))) !-------------------------------------------------------------------------------------------------- ! average segment length for screw dislocations in matrix forall (s = 1_pInt:ns) & - tempState(4_pInt*ns+nt+s) = constitutive_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product(tempState(1:ns), & + plasticState(ph)%state(4_pInt*ns+nt+s, of) = constitutive_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & + sqrt(dot_product(plasticState(ph)%state(1:ns, of), & constitutive_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product(tempState(ns+1_pInt:2_pInt*ns), & + dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & constitutive_titanmod_forestProjectionScrew(1:ns,s,instance))) !-------------------------------------------------------------------------------------------------- ! threshold stress or slip resistance for edge dislocation motion forall (s = 1_pInt:ns) & - tempState(5_pInt*ns+nt+s) = & - lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& - sqrt(dot_product((tempState(1:ns)),& + plasticState(ph)%state(5_pInt*ns+nt+s, of) = & + lattice_mu(ph)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& + sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& constitutive_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & - dot_product((tempState(ns+1_pInt:2_pInt*ns)),& + dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))) !-------------------------------------------------------------------------------------------------- ! threshold stress or slip resistance for screw dislocation motion forall (s = 1_pInt:ns) & - tempState(6_pInt*ns+nt+s) = & - lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& - sqrt(dot_product((tempState(1:ns)),& + plasticState(ph)%state(6_pInt*ns+nt+s, of) = & + lattice_mu(ph)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& + sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))+ & - dot_product((tempState(ns+1_pInt:2_pInt*ns)),& + dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& constitutive_titanmod_interactionMatrix_ss(1:ns,s,instance))) !-------------------------------------------------------------------------------------------------- ! threshold stress or slip resistance for dislocation motion in twin forall (t = 1_pInt:nt) & - tempState(7_pInt*ns+nt+t) = & - lattice_mu(phase)*constitutive_titanmod_burgersPerTwinSys(t,instance)*& - (dot_product((abs(tempState(2_pInt*ns+1_pInt:2_pInt*ns+nt))),& + plasticState(ph)%state(7_pInt*ns+nt+t, of) = & + lattice_mu(ph)*constitutive_titanmod_burgersPerTwinSys(t,instance)*& + (dot_product((abs(plasticState(ph)%state(2_pInt*ns+1_pInt:2_pInt*ns+nt, of))),& constitutive_titanmod_interactionMatrixTwinTwin(1:nt,t,instance))) -#ifdef NEWSTATE - state=tempState -#else - state%p = tempState -#endif - +! state=tempState + end subroutine constitutive_titanmod_microstructure !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& - temperature,state,ipc,ip,el) +subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,temperature,ipc,ip,el) use prec, only: & p_vec use math, only: & @@ -1527,7 +1346,9 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& use material, only: & homogenization_maxNgrains, & material_phase, & - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive implicit none real(pReal), dimension(3,3), intent(out) :: & @@ -1543,21 +1364,12 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(:), intent(inout) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(inout) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif integer(pInt) :: & - index_myFamily, instance,phase, & + index_myFamily, instance, & ns,nt, & - f,i,j,k,l,m,n + f,i,j,k,l,m,n, & + ph, & + of real(pReal) :: sumf, & StressRatio_edge_p, minusStressRatio_edge_p, StressRatio_edge_pminus1, BoltzmannRatioedge, & StressRatio_screw_p, minusStressRatio_screw_p, StressRatio_screw_pminus1, BoltzmannRatioscrew, & @@ -1571,23 +1383,20 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,dgdot_dtautwin,tau_twin, volumefraction_PerTwinSys +! tempState=state -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif !-------------------------------------------------------------------------------------------------- ! shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) do i=1_pInt,nt - volumefraction_PerTwinSys(i)=tempState(3_pInt*ns+i)/ & + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & constitutive_titanmod_twinshearconstant_PerTwinSys(i,instance) enddo @@ -1606,16 +1415,16 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& dgdot_dtauslip = 0.0_pReal j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) - if(lattice_structure(phase)==LATTICE_hex_ID) then ! only for prismatic and pyr systems in hex + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + if(lattice_structure(ph)==LATTICE_hex_ID) then ! only for prismatic and pyr systems in hex screwvelocity_prefactor=constitutive_titanmod_debyefrequency(instance)* & - tempState(4_pInt*ns+nt+j)*(constitutive_titanmod_burgersPerSlipSys(j,instance)/ & + plasticState(ph)%state(4_pInt*ns+nt+j, of)*(constitutive_titanmod_burgersPerSlipSys(j,instance)/ & constitutive_titanmod_kinkcriticallength_PerSlipSys(j,instance))**2 !* Stress ratio for screw ! No slip resistance for screw dislocations, only Peierls stress @@ -1640,7 +1449,8 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& else ! if the structure is not hex or the slip family is basal screwvelocity_prefactor=constitutive_titanmod_v0s_PerSlipSys(j,instance) - bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,instance)+tempState(6*ns+nt+j) + bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,instance)+ & + plasticState(ph)%state(6*ns+nt+j, of) StressRatio_screw_p = ((abs(tau_slip(j)))/( bottomstress_screw ))**constitutive_titanmod_ps_PerSlipSys(j,instance) if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then @@ -1658,7 +1468,8 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& endif !* Stress ratio for edge - bottomstress_edge=constitutive_titanmod_tau0e_PerSlipSys(j,instance)+tempState(5*ns+nt+j) + bottomstress_edge=constitutive_titanmod_tau0e_PerSlipSys(j,instance)+ & + plasticState(ph)%state(5*ns+nt+j, of) StressRatio_edge_p = ((abs(tau_slip(j)))/ & ( bottomstress_edge) & )**constitutive_titanmod_pe_PerSlipSys(j,instance) @@ -1684,29 +1495,29 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& constitutive_titanmod_qe_PerSlipSys(j,instance)) !* Shear rates due to edge slip - gdot_slip_edge(j) = constitutive_titanmod_burgersPerSlipSys(j,instance)*(tempState(j)* & + gdot_slip_edge(j) = constitutive_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(j, of)* & edge_velocity(j))* sign(1.0_pReal,tau_slip(j)) !* Shear rates due to screw slip - gdot_slip_screw(j) = constitutive_titanmod_burgersPerSlipSys(j,instance)*(tempState(ns+j) * & + gdot_slip_screw(j) = constitutive_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(ns+j, of) * & screw_velocity(j))* sign(1.0_pReal,tau_slip(j)) !Total shear rate gdot_slip(j) = gdot_slip_edge(j) + gdot_slip_screw(j) - tempState(7*ns+2*nt+j)=edge_velocity(j) - tempState(8*ns+2*nt+j)=screw_velocity(j) - tempState(9*ns+2*nt+j)=tau_slip(j) - tempState(10*ns+2*nt+j)=gdot_slip_edge(j) - tempState(11*ns+2*nt+j)=gdot_slip_screw(j) - tempState(12*ns+2*nt+j)=StressRatio_edge_p - tempState(13*ns+2*nt+j)=StressRatio_screw_p + plasticState(ph)%state( 7*ns+2*nt+j, of)= edge_velocity(j) + plasticState(ph)%state( 8*ns+2*nt+j, of)= screw_velocity(j) + plasticState(ph)%state( 9*ns+2*nt+j, of)= tau_slip(j) + plasticState(ph)%state(10*ns+2*nt+j, of)= gdot_slip_edge(j) + plasticState(ph)%state(11*ns+2*nt+j, of)= gdot_slip_screw(j) + plasticState(ph)%state(12*ns+2*nt+j, of)= StressRatio_edge_p + plasticState(ph)%state(13*ns+2*nt+j, of)= StressRatio_screw_p !* Derivatives of shear rates dgdot_dtauslip(j) = constitutive_titanmod_burgersPerSlipSys(j,instance)*(( & ( & ( & ( & - (edge_velocity(j)*tempState(j))) * & + (edge_velocity(j)*plasticState(ph)%state(j, of))) * & BoltzmannRatioedge*& constitutive_titanmod_pe_PerSlipSys(j,instance)* & constitutive_titanmod_qe_PerSlipSys(j,instance) & @@ -1719,7 +1530,7 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& ( & ( & ( & - (tempState(ns+j) * screw_velocity(j)) * & + (plasticState(ph)%state(ns+j, of) * screw_velocity(j)) * & BoltzmannRatioscrew* & constitutive_titanmod_ps_PerSlipSys(j,instance)* & constitutive_titanmod_qs_PerSlipSys(j,instance) & @@ -1735,14 +1546,14 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& !************************************************* !sumf=0.0_pReal !* Plastic velocity gradient for dislocation glide - Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) + Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtauslip(j)*& - lattice_Sslip(k,l,1,index_myFamily+i,phase)*& - lattice_Sslip(m,n,1,index_myFamily+i,phase) + lattice_Sslip(k,l,1,index_myFamily+i,ph)*& + lattice_Sslip(m,n,1,index_myFamily+i,ph) enddo enddo slipFamiliesLoop @@ -1751,30 +1562,30 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& dgdot_dtautwin = 0.0_pReal j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Ntwin(f,instance) ! process each (active) slip system in family j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) !************************************************************************************** !* Stress ratios -! StressRatio_r = (state%p(6*ns+3*nt+j)/tau_twin(j))**constitutive_titanmod_r(instance) +! StressRatio_r = (plasticState(ph)%state6*ns+3*nt+j, of)/tau_twin(j))**constitutive_titanmod_r(instance) !* Shear rates and their derivatives due to twin ! if ( tau_twin(j) > 0.0_pReal ) !then ! gdot_twin(j) = 0.0_pReal!& -! (constitutive_titanmod_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,phase)*& -! state%p(6*ns+4*nt+j)*constitutive_titanmod_Ndot0PerTwinSys(f,instance)*exp(-StressRatio_r) +! (constitutive_titanmod_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& +! plasticState(ph)%state(6*ns+4*nt+j, of)*constitutive_titanmod_Ndot0PerTwinSys(f,instance)*exp(-StressRatio_r) ! dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_titanmod_r(instance))/tau_twin(j))*StressRatio_r ! endif !************************************************************************************** !* Stress ratio for edge twinStressRatio_p = ((abs(tau_twin(j)))/ & - ( constitutive_titanmod_twintau0_PerTwinSys(j,instance)+tempState(7*ns+nt+j)) & + ( constitutive_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & )**constitutive_titanmod_twinp_PerTwinSys(j,instance) if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then @@ -1784,7 +1595,7 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& endif twinStressRatio_pminus1 = ((abs(tau_twin(j)))/ & - ( constitutive_titanmod_twintau0_PerTwinSys(j,instance)+tempState(7*ns+nt+j)) & + ( constitutive_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & )**(constitutive_titanmod_twinp_PerTwinSys(j,instance)-1.0_pReal) !* Boltzmann ratio @@ -1815,24 +1626,21 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& ) !* sign(1.0_pReal,tau_slip(j)) !* Plastic velocity gradient for mechanical twinning -! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,phase) - Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,phase) +! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) + Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin(j)*& - lattice_Stwin(k,l,index_myFamily+i,phase)*& - lattice_Stwin(m,n,index_myFamily+i,phase) + lattice_Stwin(k,l,index_myFamily+i,ph)*& + lattice_Stwin(m,n,index_myFamily+i,ph) enddo enddo twinFamiliesLoop dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif +! tempState=state + end subroutine constitutive_titanmod_LpAndItsTangent @@ -1840,7 +1648,7 @@ end subroutine constitutive_titanmod_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_titanmod_dotState(Tstar_v,temperature,state,ipc,ip,el) +subroutine constitutive_titanmod_dotState(Tstar_v,temperature,ipc,ip,el) use prec, only: & p_vec use lattice, only: & @@ -1855,7 +1663,9 @@ function constitutive_titanmod_dotState(Tstar_v,temperature,state,ipc,ip,el) use material, only: & homogenization_maxNgrains, & material_phase, & - phase_plasticityInstance + phase_plasticityInstance, & + plasticState, & + mappingConstitutive implicit none real(pReal), dimension(6), intent(in):: & @@ -1866,26 +1676,13 @@ implicit none ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - tempState - real(pReal), dimension(size(state)) :: & - constitutive_titanmod_dotState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState - real(pReal), dimension(constitutive_titanmod_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - constitutive_titanmod_dotState -#endif integer(pInt) :: & - index_myFamily, instance,phase, & + index_myFamily, instance, & ns,nt,& - f,i,j + f,i,j, & + ph, & + of real(pReal) :: & sumf,BoltzmannRatio, & twinStressRatio_p,twinminusStressRatio_p @@ -1901,59 +1698,59 @@ implicit none !-------------------------------------------------------------------------------------------------- ! shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=tempState(3_pInt*ns+i)/ & + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & constitutive_titanmod_twinshearconstant_PerTwinSys(i,instance) enddo sumf = sum(abs(volumefraction_PerTwinSys(1_pInt:nt))) ! safe for nt == 0 - constitutive_titanmod_dotState = 0.0_pReal - + plasticState(ph)%dotState(:,of) = 0.0_pReal j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt DotRhoEdgeGeneration(j) = & ! multiplication of edge dislocations - tempState(ns+j)*tempState(8*ns+2*nt+j)/tempState(4*ns+nt+j) + plasticState(ph)%state(ns+j, of)*plasticState(ph)%state(8*ns+2*nt+j, of)/plasticState(ph)%state(4*ns+nt+j, of) DotRhoScrewGeneration(j) = & ! multiplication of screw dislocations - tempState(j)*tempState(7*ns+2*nt+j)/tempState(3*ns+nt+j) - DotRhoEdgeAnnihilation(j) = -((tempState(j))**2)* & ! annihilation of edge dislocations - constitutive_titanmod_capre_PerSlipSys(j,instance)*tempState(7*ns+2*nt+j)*0.5_pReal - DotRhoScrewAnnihilation(j) = -((tempState(ns+j))**2)* & ! annihilation of screw dislocations - constitutive_titanmod_caprs_PerSlipSys(j,instance)*tempState(8*ns+2*nt+j)*0.5_pReal - constitutive_titanmod_dotState(j) = & ! edge dislocation density rate of change + plasticState(ph)%state(j, of)*plasticState(ph)%state(7*ns+2*nt+j, of)/plasticState(ph)%state(3*ns+nt+j, of) + DotRhoEdgeAnnihilation(j) = -((plasticState(ph)%state(j, of))**2)* & ! annihilation of edge dislocations + constitutive_titanmod_capre_PerSlipSys(j,instance)*plasticState(ph)%state(7*ns+2*nt+j, of)*0.5_pReal + DotRhoScrewAnnihilation(j) = -((plasticState(ph)%state(ns+j, of))**2)* & ! annihilation of screw dislocations + constitutive_titanmod_caprs_PerSlipSys(j,instance)*plasticState(ph)%state(8*ns+2*nt+j, of)*0.5_pReal + plasticState(ph)%dotState(j, of) = & ! edge dislocation density rate of change DotRhoEdgeGeneration(j)+DotRhoEdgeAnnihilation(j) - constitutive_titanmod_dotState(ns+j) = & ! screw dislocation density rate of change + plasticState(ph)%dotState(ns+j, of) = & ! screw dislocation density rate of change DotRhoScrewGeneration(j)+DotRhoScrewAnnihilation(j) - constitutive_titanmod_dotState(2*ns+j) = & ! sum of shear due to edge and screw - tempState(10*ns+2*nt+j)+tempState(11*ns+2*nt+j) + plasticState(ph)%dotState(2*ns+j, of) = & ! sum of shear due to edge and screw + plasticState(ph)%state(10*ns+2*nt+j, of)+plasticState(ph)%state(11*ns+2*nt+j, of) enddo enddo slipFamiliesLoop !* Twin fraction evolution j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) !* Stress ratio for edge twinStressRatio_p = ((abs(tau_twin(j)))/ & - ( constitutive_titanmod_twintau0_PerTwinSys(j,instance)+tempState(7*ns+nt+j)) & + ( constitutive_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & )**(constitutive_titanmod_twinp_PerTwinSys(j,instance)) @@ -1969,18 +1766,18 @@ implicit none (twinminusStressRatio_p)** & constitutive_titanmod_twinq_PerTwinSys(j,instance))*sign(1.0_pReal,tau_twin(j)) - constitutive_titanmod_dotState(3*ns+j)=gdot_twin(j) + plasticState(ph)%dotState(3*ns+j, of)=gdot_twin(j) enddo enddo twinFamiliesLoop -end function constitutive_titanmod_dotState +end subroutine constitutive_titanmod_dotState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -pure function constitutive_titanmod_postResults(state,ipc,ip,el) +function constitutive_titanmod_postResults(ipc,ip,el) use prec, only: & p_vec use mesh, only: & @@ -1990,50 +1787,39 @@ pure function constitutive_titanmod_postResults(state,ipc,ip,el) homogenization_maxNgrains, & material_phase, & phase_plasticityInstance, & - phase_Noutput + phase_Noutput, & + plasticState, & + mappingConstitutive implicit none integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element -#ifdef NEWSTATE - real(pReal), dimension(:), intent(in) :: & - state - real(pReal), dimension(size(state)) :: & - tempState -#else - type(p_vec), intent(in) :: & - state !< microstructure state - real(pReal), dimension(size(state%p)) :: & - tempState -#endif real(pReal), dimension(constitutive_titanmod_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & constitutive_titanmod_postResults integer(pInt) :: & - instance, phase,& + instance, & ns,nt,& - o,i,c + o,i,c, & + ph, & + of real(pReal) :: sumf real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & volumefraction_PerTwinSys - + !-------------------------------------------------------------------------------------------------- -#ifdef NEWSTATE - tempState=state -#else - tempState = state%p -#endif ! shortened notation - phase = material_phase(ipc,ip,el) - instance = phase_plasticityInstance(phase) + of = mappingConstitutive(1,ipc,ip,el) + ph = mappingConstitutive(2,ipc,ip,el) + instance = phase_plasticityInstance(ph) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) do i=1_pInt,nt - volumefraction_PerTwinSys(i)=tempState(3_pInt*ns+i)/ & + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & constitutive_titanmod_twinshearconstant_PerTwinSys(i,instance) enddo @@ -2048,91 +1834,91 @@ pure function constitutive_titanmod_postResults(state,ipc,ip,el) do o = 1_pInt,constitutive_titanmod_Noutput(instance) select case(constitutive_titanmod_outputID(o,instance)) case (rhoedge_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(1_pInt:ns) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(1_pInt:ns, of) c = c + ns case (rhoscrew_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(ns+1_pInt:2_pInt*ns) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of) c = c + ns case (segment_edge_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(3_pInt*ns+nt+1_pInt:4_pInt*ns+nt) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(3_pInt*ns+nt+1_pInt:4_pInt*ns+nt, of) c = c + ns case (segment_screw_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(4_pInt*ns+nt+1_pInt:5_pInt*ns+nt) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(4_pInt*ns+nt+1_pInt:5_pInt*ns+nt, of) c = c + ns case (resistance_edge_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(5_pInt*ns+nt+1_pInt:6_pInt*ns+nt) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(5_pInt*ns+nt+1_pInt:6_pInt*ns+nt, of) c = c + ns case (resistance_screw_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(6_pInt*ns+nt+1_pInt:7_pInt*ns+nt) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(6_pInt*ns+nt+1_pInt:7_pInt*ns+nt, of) c = c + ns case (velocity_edge_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(7*ns+2*nt+1:8*ns+2*nt) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(7*ns+2*nt+1:8*ns+2*nt, of) c = c + ns case (velocity_screw_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = tempState(8*ns+2*nt+1:9*ns+2*nt) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(8*ns+2*nt+1:9*ns+2*nt, of) c = c + ns case (tau_slip_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(tempState(9*ns+2*nt+1:10*ns+2*nt)) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(9*ns+2*nt+1:10*ns+2*nt, of)) c = c + ns case (gdot_slip_edge_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(tempState(10*ns+2*nt+1:11*ns+2*nt)) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) c = c + ns case (gdot_slip_screw_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(tempState(11*ns+2*nt+1:12*ns+2*nt)) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) c = c + ns case (gdot_slip_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(tempState(10*ns+2*nt+1:11*ns+2*nt)) + & - abs(tempState(11*ns+2*nt+1:12*ns+2*nt)) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) + & + abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) c = c + ns case (stressratio_edge_p_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(tempState(12*ns+2*nt+1:13*ns+2*nt)) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(12*ns+2*nt+1:13*ns+2*nt, of)) c = c + ns case (stressratio_screw_p_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(tempState(13*ns+2*nt+1:14*ns+2*nt)) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(13*ns+2*nt+1:14*ns+2*nt, of)) c = c + ns case (shear_system_ID) - constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(tempState(2*ns+1:3*ns)) + constitutive_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(2*ns+1:3*ns, of)) c = c + ns case (shear_basal_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(tempState(2*ns+1:2*ns+3))) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:2*ns+3, of))) c = c + 1_pInt case (shear_prism_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(tempState(2*ns+4:2*ns+6))) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+4:2*ns+6, of))) c = c + 1_pInt case (shear_pyra_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(tempState(2*ns+7:2*ns+12))) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+7:2*ns+12, of))) c = c + 1_pInt case (shear_pyrca_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(tempState(2*ns+13:2*ns+24))) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+13:2*ns+24, of))) c = c + 1_pInt case (rhoedge_basal_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(1:3)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(1:3, of)) c = c + 1_pInt case (rhoedge_prism_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(4:6)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(4:6, of)) c = c + 1_pInt case (rhoedge_pyra_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(7:12)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(7:12,of)) c = c + 1_pInt case (rhoedge_pyrca_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(13:24)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(13:24, of)) c = c + 1_pInt case (rhoscrew_basal_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(ns+1:ns+3)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+1:ns+3, of)) c = c + 1_pInt case (rhoscrew_prism_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(ns+4:ns+6)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+4:ns+6, of)) c = c + 1_pInt case (rhoscrew_pyra_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(ns+7:ns+12)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+7:ns+12, of)) c = c + 1_pInt case (rhoscrew_pyrca_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(tempState(ns+13:ns+24)) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+13:ns+24, of)) c = c + 1_pInt case (shear_total_ID) - constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(tempState(2*ns+1:3*ns))) + constitutive_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:3*ns, of))) c = c + 1_pInt case (twin_fraction_ID) constitutive_titanmod_postResults(c+1_pInt:c+nt) = abs(volumefraction_PerTwinSys(1:nt)) diff --git a/code/crystallite.f90 b/code/crystallite.f90 index c9e3278f5..ab28607de 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -174,12 +174,10 @@ subroutine crystallite_init(temperature) lattice_structure use constitutive, only: & constitutive_microstructure -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_microstructure use constitutive_thermal, only: & constitutive_thermal_microstructure -#endif implicit none real(pReal), intent(in) :: temperature @@ -426,15 +424,13 @@ subroutine crystallite_init(temperature) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1_pInt,myNgrains call constitutive_microstructure(temperature, & - crystallite_Fe(1:3,1:3,g,i,e), crystallite_Fp(1:3,1:3,g,i,e),g,i,e) ! update dependent state variables to be consistent with basic states -#ifdef NEWSTATE + crystallite_Fe(1:3,1:3,g,i,e), crystallite_Fp(1:3,1:3,g,i,e),g,i,e) ! update dependent state variables to be consistent with basic states call constitutive_damage_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states call constitutive_thermal_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states -#endif enddo enddo enddo @@ -548,24 +544,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) FE_cellType use material, only: & homogenization_Ngrains, & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_maxNgrains use constitutive, only: & -#ifndef NEWSTATE - constitutive_sizeState, & - constitutive_sizeDotState, & - constitutive_state, & - constitutive_state_backup, & - constitutive_subState0, & - constitutive_partionedState0, & - constitutive_dotState, & - constitutive_dotState_backup, & -#endif constitutive_TandItsTangent implicit none @@ -645,16 +629,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) myNgrains = homogenization_Ngrains(mesh_element(3,e)) forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & g = 1_pInt:myNgrains, crystallite_requested(g,i,e)) -#ifdef NEWSTATE plasticState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) damageState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) = & damageState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) -#else - constitutive_subState0(g,i,e)%p = constitutive_partionedState0(g,i,e)%p ! ...microstructure -#endif crystallite_subFp0(1:3,1:3,g,i,e) = crystallite_partionedFp0(1:3,1:3,g,i,e) ! ...plastic def grad crystallite_subLp0(1:3,1:3,g,i,e) = crystallite_partionedLp0(1:3,1:3,g,i,e) ! ...plastic velocity grad crystallite_dPdF0(1:3,1:3,1:3,1:3,g,i,e) = crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,g,i,e) ! ...stiffness @@ -932,7 +912,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) math_mul33x33(crystallite_subF(1:3,1:3,g,i,e), crystallite_invFp(1:3,1:3,g,i,e)) ! only needed later on for stiffness calculation crystallite_subLp0(1:3,1:3,g,i,e) = crystallite_Lp(1:3,1:3,g,i,e) ! ...plastic velocity gradient -#ifdef NEWSTATE !if abbrevation, make c and p private in omp plasticState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) @@ -940,9 +919,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) damageState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) -#else - constitutive_subState0(g,i,e)%p = constitutive_state(g,i,e)%p ! ...microstructure -#endif crystallite_subTstar0_v(1:6,g,i,e) = crystallite_Tstar_v(1:6,g,i,e) ! ...2nd PK stress if (crystallite_syncSubFrac(i,e)) then ! if we just did a synchronization of states, then we wind forward without any further time integration crystallite_syncSubFracCompleted(i,e) = .true. @@ -986,16 +962,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) crystallite_invFp(1:3,1:3,g,i,e) = math_inv33(crystallite_Fp(1:3,1:3,g,i,e)) !$OMP FLUSH(crystallite_invFp) crystallite_Lp(1:3,1:3,g,i,e) = crystallite_subLp0(1:3,1:3,g,i,e) ! ...plastic velocity grad -#ifndef NEWSTATE - constitutive_state(g,i,e)%p = constitutive_subState0(g,i,e)%p ! ...microstructure -#else plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) damageState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & damageState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) -#endif crystallite_Tstar_v(1:6,g,i,e) = crystallite_subTstar0_v(1:6,g,i,e) ! ...2nd PK stress ! cant restore dotState here, since not yet calculated in first cutback after initialization @@ -1201,7 +1173,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) elementLooping7: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(mesh_element(3,e)) forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), g = 1:myNgrains) -#ifdef NEWSTATE plasticState(mappingConstitutive(2,g,i,e))%state_backup(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) plasticState(mappingConstitutive(2,g,i,e))%dotState_backup(:,mappingConstitutive(1,g,i,e)) = & @@ -1214,13 +1185,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) thermalState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%dotState_backup(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%dotState(:,mappingConstitutive(1,g,i,e)) -#else - constitutive_state_backup(g,i,e)%p(1:constitutive_sizeState(g,i,e)) = & - constitutive_state(g,i,e)%p(1:constitutive_sizeState(g,i,e)) ! remember unperturbed, converged state, ... - constitutive_dotState_backup(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) = & - constitutive_dotState(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) ! ... dotStates, ... -#endif - + F_backup(1:3,1:3,g,i,e) = crystallite_subF(1:3,1:3,g,i,e) ! ... and kinematics Fp_backup(1:3,1:3,g,i,e) = crystallite_Fp(1:3,1:3,g,i,e) InvFp_backup(1:3,1:3,g,i,e) = crystallite_invFp(1:3,1:3,g,i,e) @@ -1252,7 +1217,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(mesh_element(3,e)) forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), g = 1:myNgrains) -#ifdef NEWSTATE plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%state_backup(:,mappingConstitutive(1,g,i,e)) plasticState(mappingConstitutive(2,g,i,e))%dotState(:,mappingConstitutive(1,g,i,e)) = & @@ -1265,12 +1229,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) thermalState(mappingConstitutive(2,g,i,e))%state_backup(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%dotState(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%dotState_backup(:,mappingConstitutive(1,g,i,e)) -#else - constitutive_state(g,i,e)%p(1:constitutive_sizeState(g,i,e)) = & - constitutive_state_backup(g,i,e)%p(1:constitutive_sizeState(g,i,e)) - constitutive_dotState(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) = & - constitutive_dotState_backup(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) -#endif crystallite_Fp(1:3,1:3,g,i,e) = Fp_backup(1:3,1:3,g,i,e) crystallite_invFp(1:3,1:3,g,i,e) = InvFp_backup(1:3,1:3,g,i,e) crystallite_Fe(1:3,1:3,g,i,e) = Fe_backup(1:3,1:3,g,i,e) @@ -1284,7 +1242,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(mesh_element(3,e)) forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), g = 1:myNgrains) -#ifdef NEWSTATE plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) plasticState(mappingConstitutive(2,g,i,e))%dotState(:,mappingConstitutive(1,g,i,e)) = & @@ -1297,12 +1254,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) thermalState(mappingConstitutive(2,g,i,e))%subState0(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%dotState(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%dotState_backup(:,mappingConstitutive(1,g,i,e)) -#else - constitutive_state(g,i,e)%p(1:constitutive_sizeState(g,i,e)) = & - constitutive_subState0(g,i,e)%p(1:constitutive_sizeState(g,i,e)) - constitutive_dotState(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) = & - constitutive_dotState_backup(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) -#endif crystallite_Fp(1:3,1:3,g,i,e) = crystallite_subFp0(1:3,1:3,g,i,e) crystallite_Fe(1:3,1:3,g,i,e) = crystallite_subFe0(1:3,1:3,g,i,e) crystallite_Lp(1:3,1:3,g,i,e) = crystallite_subLp0(1:3,1:3,g,i,e) @@ -1388,7 +1339,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) elementLooping10: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(mesh_element(3,e)) forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), g = 1:myNgrains) -#ifdef NEWSTATE plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%state_backup(:,mappingConstitutive(1,g,i,e)) plasticState(mappingConstitutive(2,g,i,e))%dotState(:,mappingConstitutive(1,g,i,e)) = & @@ -1401,13 +1351,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco,rate_sensitivity) thermalState(mappingConstitutive(2,g,i,e))%state_backup(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%dotState(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%dotState_backup(:,mappingConstitutive(1,g,i,e)) -#else - constitutive_state(g,i,e)%p(1:constitutive_sizeState(g,i,e)) = & - constitutive_state_backup(g,i,e)%p(1:constitutive_sizeState(g,i,e)) - constitutive_dotState(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) = & - constitutive_dotState_backup(g,i,e)%p(1:constitutive_sizeDotState(g,i,e)) -#endif - crystallite_subF(1:3,1:3,g,i,e) = F_backup(1:3,1:3,g,i,e) crystallite_Fp(1:3,1:3,g,i,e) = Fp_backup(1:3,1:3,g,i,e) crystallite_invFp(1:3,1:3,g,i,e) = InvFp_backup(1:3,1:3,g,i,e) @@ -1469,33 +1412,20 @@ subroutine crystallite_integrateStateRK4() mesh_maxNips use material, only: & homogenization_Ngrains, & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_maxNgrains use constitutive, only: & constitutive_collectDotState, & -#ifndef NEWSTATE - constitutive_sizeDotState, & - constitutive_state, & - constitutive_subState0, & - constitutive_dotState, & - constitutive_RK4dotState, & - constitutive_deltaState, & - constitutive_collectDeltaState, & -#endif constitutive_microstructure -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_collectDotState, & constitutive_damage_microstructure use constitutive_thermal, only: & constitutive_thermal_collectDotState, & constitutive_thermal_microstructure -#endif implicit none real(pReal), dimension(4), parameter :: & @@ -1526,7 +1456,6 @@ subroutine crystallite_integrateStateRK4() singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) -#ifdef NEWSTATE !-------------------------------------------------------------------------------------------------- ! initialize dotState if (.not. singleRun) then @@ -1542,28 +1471,22 @@ subroutine crystallite_integrateStateRK4() thermalState(mappingConstitutive(2,g,i,e))%RK4dotState(:,mappingConstitutive(1,g,i,e)) = 0.0_pReal enddo endif -#endif !-------------------------------------------------------------------------------------------------- ! first Runge-Kutta step !$OMP PARALLEL !$OMP DO do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains -#ifndef NEWSTATE - constitutive_RK4dotState(g,i,e)%p = 0.0_pReal ! initialize Runge-Kutta dotState -#endif if (crystallite_todo(g,i,e)) then call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), crystallite_Fe, & crystallite_Fp, crystallite_temperature(i,e), & crystallite_subdt(g,i,e), crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -1572,17 +1495,6 @@ subroutine crystallite_integrateStateRK4() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p)) then ! NaN occured in dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif -#else c = mappingConstitutive(1,g,i,e) p = mappingConstitutive(2,g,i,e) if ( any(plasticState(p)%dotState(:,c) /= plasticState(p)%dotState(:,c)) .or.& @@ -1596,7 +1508,6 @@ subroutine crystallite_integrateStateRK4() crystallite_todo(g,i,e) = .false. ! ... skip this one next time endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -1611,34 +1522,25 @@ subroutine crystallite_integrateStateRK4() !$OMP DO PRIVATE(p,c) 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 -#ifdef NEWSTATE p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) -#endif first3steps: if (n < 4) then -#ifndef NEWSTATE - constitutive_RK4dotState(g,i,e)%p = constitutive_RK4dotState(g,i,e)%p & - + weight(n)*constitutive_dotState(g,i,e)%p -#else + plasticState(p)%RK4dotState(:,c) = plasticState(p)%RK4dotState(:,c) & + weight(n)*plasticState(p)%dotState(:,c) damageState(p)%RK4dotState(:,c) = damageState(p)%RK4dotState(:,c) & + weight(n)*damageState(p)%dotState(:,c) thermalState(p)%RK4dotState(:,c) = thermalState(p)%RK4dotState(:,c) & + weight(n)*thermalState(p)%dotState(:,c) -#endif else first3steps -#ifndef NEWSTATE - constitutive_dotState(g,i,e)%p = (constitutive_RK4dotState(g,i,e)%p & - + weight(n)*constitutive_dotState(g,i,e)%p) / 6.0_pReal ! use weighted RKdotState for final integration -#else + plasticState(p)%RK4dotState(:,c) = plasticState(p)%RK4dotState(:,c) & + weight(n)*plasticState(p)%dotState(:,c) / 6.0_pReal damageState(p)%RK4dotState(:,c) = damageState(p)%RK4dotState(:,c) & + weight(n)*damageState(p)%dotState(:,c) / 6.0_pReal thermalState(p)%RK4dotState(:,c) = thermalState(p)%RK4dotState(:,c) & + weight(n)*thermalState(p)%dotState(:,c) / 6.0_pReal -#endif + endif first3steps endif enddo; enddo; enddo @@ -1647,12 +1549,7 @@ subroutine crystallite_integrateStateRK4() !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,c) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_subState0(g,i,e)%p(1:mySizeDotState) & - + constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - * crystallite_subdt(g,i,e) * timeStepFraction(n) -#else + p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -1667,22 +1564,15 @@ subroutine crystallite_integrateStateRK4() thermalState(p)%State(1:mySizeThermalDotState,c) = thermalState(p)%subState0(1:mySizeThermalDotState,c) & + thermalState(p)%dotState (1:mySizeThermalDotState,c) & * crystallite_subdt(g,i,e) * timeStepFraction(n) -#endif - if (n == 4) then ! final integration step + if (n == 4) then ! final integration step #ifndef _OPENMP if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST >> updateState at el ip g ',e,i,g - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) -#else + write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', plasticState(p)%dotState(:,c) write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', plasticState(p)%State(:,c) -#endif endif #endif endif @@ -1716,14 +1606,12 @@ subroutine crystallite_integrateStateRK4() if (crystallite_todo(g,i,e)) then call constitutive_microstructure(crystallite_temperature(i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states -#ifdef NEWSTATE call constitutive_damage_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states call constitutive_thermal_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -1757,14 +1645,12 @@ subroutine crystallite_integrateStateRK4() crystallite_Fp, crystallite_temperature(i,e), & timeStepFraction(n)*crystallite_subdt(g,i,e), & ! fraction of original timestep crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -1773,17 +1659,7 @@ subroutine crystallite_integrateStateRK4() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p)) then ! NaN occured in dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif -#else + p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) if ( any(plasticState(p)%dotState(:,c) /= plasticState(p)%dotState(:,c)) .or.& @@ -1797,7 +1673,6 @@ subroutine crystallite_integrateStateRK4() crystallite_todo(g,i,e) = .false. ! ... skip this one next time endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -1860,28 +1735,15 @@ subroutine crystallite_integrateStateRKCK45() mesh_maxNips use material, only: & homogenization_Ngrains, & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_maxNgrains use constitutive, only: & constitutive_collectDotState, & constitutive_maxSizeDotState, & -#ifndef NEWSTATE - constitutive_sizeDotState, & - constitutive_state, & - constitutive_aTolState, & - constitutive_subState0, & - constitutive_dotState, & - constitutive_RKCK45dotState, & - constitutive_deltaState, & - constitutive_collectDeltaState, & -#endif constitutive_microstructure -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_collectDotState, & constitutive_damage_microstructure, & @@ -1890,7 +1752,6 @@ subroutine crystallite_integrateStateRKCK45() constitutive_thermal_collectDotState, & constitutive_thermal_microstructure, & constitutive_thermal_maxSizeDotState -#endif implicit none @@ -1935,14 +1796,12 @@ subroutine crystallite_integrateStateRKCK45() real(pReal), dimension(constitutive_maxSizeDotState,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & stateResiduum, & ! residuum from evolution in micrstructure relStateResiduum ! relative residuum from evolution in microstructure -#ifdef NEWSTATE real(pReal), dimension(constitutive_damage_maxSizeDotState,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & damageStateResiduum, & ! residuum from evolution in micrstructure relDamageStateResiduum ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_thermal_maxSizeDotState,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & thermalStateResiduum, & ! residuum from evolution in micrstructure relThermalStateResiduum ! relative residuum from evolution in microstructure -#endif logical :: & singleRun ! flag indicating computation for single (g,i,e) triple @@ -1969,14 +1828,12 @@ subroutine crystallite_integrateStateRKCK45() call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), crystallite_Fe, & crystallite_Fp, crystallite_temperature(i,e), & crystallite_subdt(g,i,e), crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -1984,17 +1841,6 @@ subroutine crystallite_integrateStateRKCK45() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p)) then ! NaN occured in dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif -#else cc = mappingConstitutive(1,g,i,e) p = mappingConstitutive(2,g,i,e) if ( any(plasticState(p)%dotState(:,cc) /= plasticState(p)%dotState(:,cc)) .or.& @@ -2008,7 +1854,6 @@ subroutine crystallite_integrateStateRKCK45() crystallite_todo(g,i,e) = .false. ! ... skip this one next time endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2025,51 +1870,36 @@ subroutine crystallite_integrateStateRKCK45() !$OMP DO PRIVATE(p,cc) 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 -#ifndef NEWSTATE - constitutive_RKCK45dotState(n,g,i,e)%p = constitutive_dotState(g,i,e)%p ! store Runge-Kutta dotState -#else p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) plasticState(p)%RKCK45dotState(n,:,cc) = plasticState(p)%dotState(:,cc) ! store Runge-Kutta dotState damageState(p)%RKCK45dotState(n,:,cc) = damageState(p)%dotState(:,cc) ! store Runge-Kutta dotState thermalState(p)%RKCK45dotState(n,:,cc) = thermalState(p)%dotState(:,cc) ! store Runge-Kutta dotState -#endif endif enddo; enddo; enddo !$OMP ENDDO !$OMP DO PRIVATE(p,cc) 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 -#ifdef NEWSTATE p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) -#endif if (n == 1) then ! NEED TO DO THE ADDITION IN THIS LENGTHY WAY BECAUSE OF PARALLELIZATION (CAN'T USE A REDUCTION CLAUSE ON A POINTER OR USER DEFINED TYPE) -#ifndef NEWSTATE - constitutive_dotState(g,i,e)%p = A(1,1) * constitutive_RKCK45dotState(1,g,i,e)%p -#else + plasticState(p)%dotState(:,cc) = A(1,1) * plasticState(p)%RKCK45dotState(1,:,cc) damageState(p)%dotState(:,cc) = A(1,1) * damageState(p)%RKCK45dotState(1,:,cc) thermalState(p)%dotState(:,cc) = A(1,1) * thermalState(p)%RKCK45dotState(1,:,cc) -#endif + elseif (n == 2) then -#ifndef NEWSTATE - constitutive_dotState(g,i,e)%p = A(1,2) * constitutive_RKCK45dotState(1,g,i,e)%p & - + A(2,2) * constitutive_RKCK45dotState(2,g,i,e)%p -#else + plasticState(p)%dotState(:,cc) = A(1,2) * plasticState(p)%RKCK45dotState(1,:,cc) & + A(2,2) * plasticState(p)%RKCK45dotState(2,:,cc) damageState(p)%dotState(:,cc) = A(1,1) * damageState(p)%RKCK45dotState(1,:,cc) & + A(2,2) * damageState(p)%RKCK45dotState(2,:,cc) thermalState(p)%dotState(:,cc) = A(1,1) * thermalState(p)%RKCK45dotState(1,:,cc) & + A(2,2) * thermalState(p)%RKCK45dotState(2,:,cc) -#endif + elseif (n == 3) then -#ifndef NEWSTATE - constitutive_dotState(g,i,e)%p = A(1,3) * constitutive_RKCK45dotState(1,g,i,e)%p & - + A(2,3) * constitutive_RKCK45dotState(2,g,i,e)%p & - + A(3,3) * constitutive_RKCK45dotState(3,g,i,e)%p -#else + plasticState(p)%dotState(:,cc) = A(1,3) * plasticState(p)%RKCK45dotState(1,:,cc) & + A(2,3) * plasticState(p)%RKCK45dotState(2,:,cc) & + A(3,3) * plasticState(p)%RKCK45dotState(3,:,cc) @@ -2079,14 +1909,9 @@ subroutine crystallite_integrateStateRKCK45() thermalState(p)%dotState(:,cc) = A(1,1) * thermalState(p)%RKCK45dotState(1,:,cc) & + A(2,3) * thermalState(p)%RKCK45dotState(2,:,cc) & + A(3,3) * thermalState(p)%RKCK45dotState(3,:,cc) -#endif + elseif (n == 4) then -#ifndef NEWSTATE - constitutive_dotState(g,i,e)%p = A(1,4) * constitutive_RKCK45dotState(1,g,i,e)%p & - + A(2,4) * constitutive_RKCK45dotState(2,g,i,e)%p & - + A(3,4) * constitutive_RKCK45dotState(3,g,i,e)%p & - + A(4,4) * constitutive_RKCK45dotState(4,g,i,e)%p -#else + plasticState(p)%dotState(:,cc) = A(1,4) * plasticState(p)%RKCK45dotState(1,:,cc) & + A(2,4) * plasticState(p)%RKCK45dotState(2,:,cc) & + A(3,4) * plasticState(p)%RKCK45dotState(3,:,cc) & @@ -2099,15 +1924,8 @@ subroutine crystallite_integrateStateRKCK45() + A(2,4) * thermalState(p)%RKCK45dotState(2,:,cc) & + A(3,4) * thermalState(p)%RKCK45dotState(3,:,cc) & + A(4,4) * thermalState(p)%RKCK45dotState(4,:,cc) -#endif + elseif (n == 5) then -#ifndef NEWSTATE - constitutive_dotState(g,i,e)%p = A(1,5) * constitutive_RKCK45dotState(1,g,i,e)%p & - + A(2,5) * constitutive_RKCK45dotState(2,g,i,e)%p & - + A(3,5) * constitutive_RKCK45dotState(3,g,i,e)%p & - + A(4,5) * constitutive_RKCK45dotState(4,g,i,e)%p & - + A(5,5) * constitutive_RKCK45dotState(5,g,i,e)%p -#else plasticState(p)%dotState(:,cc) = A(1,5) * plasticState(p)%RKCK45dotState(1,:,cc) & + A(2,5) * plasticState(p)%RKCK45dotState(2,:,cc) & + A(3,5) * plasticState(p)%RKCK45dotState(3,:,cc) & @@ -2123,7 +1941,7 @@ subroutine crystallite_integrateStateRKCK45() + A(3,5) * thermalState(p)%RKCK45dotState(3,:,cc) & + A(4,5) * thermalState(p)%RKCK45dotState(4,:,cc) & + A(5,5) * thermalState(p)%RKCK45dotState(5,:,cc) -#endif + endif endif enddo; enddo; enddo @@ -2131,12 +1949,6 @@ subroutine crystallite_integrateStateRKCK45() !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,cc) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_subState0(g,i,e)%p(1:mySizeDotState) & - + constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - * crystallite_subdt(g,i,e) -#else p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -2151,7 +1963,6 @@ subroutine crystallite_integrateStateRKCK45() thermalState(p)%state(1:mySizeThermalDotState,cc) = thermalState(p)%subState0(1:mySizeThermalDotState,cc) & + thermalState(p)%dotState (1:mySizeThermalDotState,cc) & * crystallite_subdt(g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2182,14 +1993,13 @@ subroutine crystallite_integrateStateRKCK45() if (crystallite_todo(g,i,e)) then call constitutive_microstructure(crystallite_temperature(i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states -#ifdef NEWSTATE call constitutive_damage_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states call constitutive_thermal_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states -#endif + endif enddo; enddo; enddo !$OMP ENDDO @@ -2225,14 +2035,12 @@ subroutine crystallite_integrateStateRKCK45() crystallite_Fp, crystallite_temperature(i,e), & C(n)*crystallite_subdt(g,i,e), & ! fraction of original timestep crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2240,15 +2048,12 @@ subroutine crystallite_integrateStateRKCK45() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p/=constitutive_dotState(g,i,e)%p)) then ! NaN occured in dotState -#else + p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) if ( any(plasticState(p)%dotState(:,cc) /= plasticState(p)%dotState(:,cc)) .or.& any(damageState(p)%dotState(:,cc) /= damageState(p)%dotState(:,cc)) .or.& any(thermalState(p)%dotState(:,cc) /= thermalState(p)%dotState(:,cc))) then ! NaN occured in dotState -#endif if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... !$OMP CRITICAL (checkTodo) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped @@ -2269,23 +2074,17 @@ subroutine crystallite_integrateStateRKCK45() ! --- STATE UPDATE WITH ERROR ESTIMATE FOR STATE --- relStateResiduum = 0.0_pReal -#ifdef NEWSTATE relDamageStateResiduum = 0.0_pReal relThermalStateResiduum = 0.0_pReal -#endif !$OMP PARALLEL !$OMP DO PRIVATE(p,cc) 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 -#ifndef NEWSTATE - constitutive_RKCK45dotState(6,g,i,e)%p = constitutive_dotState(g,i,e)%p ! store Runge-Kutta dotState -#else p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) plasticState(p)%RKCK45dotState(6,:,cc) = plasticState(p)%dotState (:,cc) ! store Runge-Kutta dotState damageState(p)%RKCK45dotState(6,:,cc) = damageState(p)%dotState (:,cc) ! store Runge-Kutta dotState thermalState(p)%RKCK45dotState(6,:,cc) = thermalState(p)%dotState (:,cc) ! store Runge-Kutta dotState -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2293,31 +2092,6 @@ subroutine crystallite_integrateStateRKCK45() !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,cc) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - - ! --- absolute residuum in state --- - ! NEED TO DO THE ADDITION IN THIS LENGTHY WAY BECAUSE OF PARALLELIZATION - ! CAN'T USE A REDUCTION CLAUSE ON A POINTER OR USER DEFINED TYPE - - stateResiduum(1:mySizeDotState,g,i,e) = & - ( DB(1) * constitutive_RKCK45dotState(1,g,i,e)%p(1:mySizeDotState) & - + DB(2) * constitutive_RKCK45dotState(2,g,i,e)%p(1:mySizeDotState) & - + DB(3) * constitutive_RKCK45dotState(3,g,i,e)%p(1:mySizeDotState) & - + DB(4) * constitutive_RKCK45dotState(4,g,i,e)%p(1:mySizeDotState) & - + DB(5) * constitutive_RKCK45dotState(5,g,i,e)%p(1:mySizeDotState) & - + DB(6) * constitutive_RKCK45dotState(6,g,i,e)%p(1:mySizeDotState)) & - * crystallite_subdt(g,i,e) - - ! --- dot state --- - - constitutive_dotState(g,i,e)%p = B(1) * constitutive_RKCK45dotState(1,g,i,e)%p & - + B(2) * constitutive_RKCK45dotState(2,g,i,e)%p & - + B(3) * constitutive_RKCK45dotState(3,g,i,e)%p & - + B(4) * constitutive_RKCK45dotState(4,g,i,e)%p & - + B(5) * constitutive_RKCK45dotState(5,g,i,e)%p & - + B(6) * constitutive_RKCK45dotState(6,g,i,e)%p -#else p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -2355,7 +2129,6 @@ subroutine crystallite_integrateStateRKCK45() + B(4) * thermalState(p)%RKCK45dotState(4,:,cc) & + B(5) * thermalState(p)%RKCK45dotState(5,:,cc) & + B(6) * thermalState(p)%RKCK45dotState(6,:,cc) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2365,12 +2138,7 @@ subroutine crystallite_integrateStateRKCK45() !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,cc) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_subState0(g,i,e)%p(1:mySizeDotState) & - + constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - * crystallite_subdt(g,i,e) -#else + p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -2385,7 +2153,6 @@ subroutine crystallite_integrateStateRKCK45() thermalState(p)%state(1:mySizeThermalDotState,cc) = thermalState(p)%subState0(1:mySizeThermalDotState,cc)& + thermalState(p)%dotState (1:mySizeThermalDotState,cc)& * crystallite_subdt(g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2395,29 +2162,6 @@ subroutine crystallite_integrateStateRKCK45() !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,cc) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - forall (s = 1_pInt:mySizeDotState, abs(constitutive_state(g,i,e)%p(s)) > 0.0_pReal) & - relStateResiduum(s,g,i,e) = stateResiduum(s,g,i,e) / constitutive_state(g,i,e)%p(s) - !$OMP FLUSH(relStateResiduum) - crystallite_todo(g,i,e) = & - ( all( abs(relStateResiduum(:,g,i,e)) < rTol_crystalliteState & - .or. abs(stateResiduum(1:mySizeDotState,g,i,e)) < constitutive_aTolState(g,i,e)%p(1:mySizeDotState) )) - -#ifndef _OPENMP - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt& - .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& - .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i8,1x,i3,1x,i3,/)') '<< CRYST >> updateState at el ip g ',e,i,g - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> absolute residuum tolerance', & - stateResiduum(1:mySizeDotState,g,i,e) / constitutive_aTolState(g,i,e)%p(1:mySizeDotState) - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> relative residuum tolerance', & - relStateResiduum(1:mySizeDotState,g,i,e) / rTol_crystalliteState - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) - endif -#endif -#else p = mappingConstitutive(2,g,i,e) cc = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -2443,6 +2187,21 @@ subroutine crystallite_integrateStateRKCK45() rTol_crystalliteState .or. & abs(thermalStateResiduum(1:mySizeThermalDotState,g,i,e)) < & thermalState(p)%aTolState(1:mySizeThermalDotState))) + +#ifndef _OPENMP + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt& + .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& + .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then + write(6,'(a,i8,1x,i3,1x,i3,/)') '<< CRYST >> updateState at el ip g ',e,i,g + write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> absolute residuum tolerance', & + stateResiduum(1:mySizeDotState,g,i,e) / plasticState(p)%aTolState(1:mySizePlasticDotState,cc) + write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> relative residuum tolerance', & + relStateResiduum(1:mySizeDotState,g,i,e) / rTol_crystalliteState + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', & + plasticState(p)%dotState(1:mySizePlasticDotState,cc) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', & + plasticState(p)%state(1:mySizePlasticDotState,cc) + endif #endif endif enddo; enddo; enddo @@ -2474,14 +2233,12 @@ subroutine crystallite_integrateStateRKCK45() if (crystallite_todo(g,i,e)) then call constitutive_microstructure(crystallite_temperature(i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states -#ifdef NEWSTATE call constitutive_damage_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states call constitutive_thermal_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2527,7 +2284,7 @@ subroutine crystallite_integrateStateRKCK45() ! --- nonlocal convergence check --- if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' ! if not requesting Integration of just a single IP + write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' ! if not requesting Integration of just a single IP if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged @@ -2561,25 +2318,15 @@ subroutine crystallite_integrateStateAdaptiveEuler() mesh_maxNips use material, only: & homogenization_Ngrains, & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_maxNgrains use constitutive, only: & constitutive_collectDotState, & constitutive_microstructure, & -#ifndef NEWSTATE - constitutive_subState0, & - constitutive_state, & - constitutive_sizeDotState, & - constitutive_dotState, & - constitutive_aTolState, & -#endif constitutive_maxSizeDotState -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_collectDotState, & constitutive_damage_microstructure, & @@ -2588,7 +2335,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() constitutive_thermal_collectDotState, & constitutive_thermal_microstructure, & constitutive_thermal_maxSizeDotState -#endif implicit none @@ -2611,14 +2357,12 @@ subroutine crystallite_integrateStateAdaptiveEuler() real(pReal), dimension(constitutive_maxSizeDotState,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & stateResiduum, & ! residuum from evolution in micrstructure relStateResiduum ! relative residuum from evolution in microstructure -#ifdef NEWSTATE real(pReal), dimension(constitutive_damage_maxSizeDotState,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & damageStateResiduum, & ! residuum from evolution in micrstructure relDamageStateResiduum ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_thermal_maxSizeDotState,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & thermalStateResiduum, & ! residuum from evolution in micrstructure relThermalStateResiduum ! relative residuum from evolution in microstructure -#endif logical :: & singleRun ! flag indicating computation for single (g,i,e) triple @@ -2636,12 +2380,10 @@ subroutine crystallite_integrateStateAdaptiveEuler() stateResiduum = 0.0_pReal relStateResiduum = 0.0_pReal -#ifdef NEWSTATE damageStateResiduum = 0.0_pReal relDamageStateResiduum = 0.0_pReal thermalStateResiduum = 0.0_pReal relThermalStateResiduum = 0.0_pReal -#endif integrationMode: if (numerics_integrationMode == 1_pInt) then @@ -2655,14 +2397,12 @@ subroutine crystallite_integrateStateAdaptiveEuler() call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), crystallite_Fe, & crystallite_Fp, crystallite_temperature(i,e), & crystallite_subdt(g,i,e), crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e ) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2670,17 +2410,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p)) then ! NaN occured in dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) if ( any(plasticState(p)%dotState(:,c) /= plasticState(p)%dotState(:,c)) .or.& @@ -2694,7 +2423,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() crystallite_todo(g,i,e) = .false. ! ... skip this one next time endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2705,14 +2433,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,c) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - stateResiduum(1:mySizeDotState,g,i,e) = - 0.5_pReal * constitutive_dotState(g,i,e)%p & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_state(g,i,e)%p(1:mySizeDotState) & - + constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - * crystallite_subdt(g,i,e) -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -2736,7 +2456,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() thermalState(p)%state(1:mySizeThermalDotState,c) = thermalState(p)%state(1:mySizeThermalDotState,c) & + thermalState(p)%dotstate(1:mySizeThermalDotState,c) & * crystallite_subdt(g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2767,14 +2486,12 @@ subroutine crystallite_integrateStateAdaptiveEuler() if (crystallite_todo(g,i,e)) & call constitutive_microstructure(crystallite_temperature(i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states -#ifdef NEWSTATE call constitutive_damage_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states call constitutive_thermal_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states -#endif enddo; enddo; enddo !$OMP ENDDO !$OMP END PARALLEL @@ -2810,31 +2527,18 @@ subroutine crystallite_integrateStateAdaptiveEuler() call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), crystallite_Fe, & crystallite_Fp, crystallite_temperature(i,e), & crystallite_subdt(g,i,e), crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif enddo; enddo; enddo !$OMP ENDDO !$OMP DO PRIVATE(p,c) do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p /= constitutive_dotState(g,i,e)%p) ) then ! NaN occured in dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) if ( any(plasticState(p)%dotState(:,c) /= plasticState(p)%dotState(:,c)) .or.& @@ -2848,7 +2552,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() crystallite_todo(g,i,e) = .false. ! ... skip this one next time endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2858,23 +2561,13 @@ subroutine crystallite_integrateStateAdaptiveEuler() !$OMP SINGLE relStateResiduum = 0.0_pReal -#ifdef NEWSTATE relDamageStateResiduum = 0.0_pReal relThermalStateResiduum = 0.0_pReal -#endif !$OMP END SINGLE !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,c) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - ! --- contribution of heun step to absolute residui --- - - stateResiduum(1:mySizeDotState,g,i,e) = stateResiduum(1:mySizeDotState,g,i,e) & - + 0.5_pReal * constitutive_dotState(g,i,e)%p & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -2884,51 +2577,27 @@ subroutine crystallite_integrateStateAdaptiveEuler() stateResiduum(1:mySizePlasticDotState,g,i,e) = stateResiduum(1:mySizePlasticDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state + * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state damageStateResiduum(1:mySizeDamageDotState,g,i,e) = damageStateResiduum(1:mySizeDamageDotState,g,i,e) & + 0.5_pReal * damageState(p)%dotState(:,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state + * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state thermalStateResiduum(1:mySizeThermalDotState,g,i,e) = thermalStateResiduum(1:mySizeThermalDotState,g,i,e) & + 0.5_pReal * thermalState(p)%dotState(:,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state -#endif + * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state !$OMP FLUSH(stateResiduum) ! --- relative residui --- -#ifndef NEWSTATE - forall (s = 1_pInt:mySizeDotState, abs(constitutive_state(g,i,e)%p(s)) > 0.0_pReal) & - relStateResiduum(s,g,i,e) = stateResiduum(s,g,i,e) / constitutive_state(g,i,e)%p(s) -#else forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & relStateResiduum(s,g,i,e) = stateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) forall (s = 1_pInt:mySizeDamageDotState, abs(damageState(p)%dotState(s,c)) > 0.0_pReal) & relDamageStateResiduum(s,g,i,e) = damageStateResiduum(s,g,i,e) / damageState(p)%dotState(s,c) forall (s = 1_pInt:mySizeThermalDotState, abs(thermalState(p)%dotState(s,c)) > 0.0_pReal) & relThermalStateResiduum(s,g,i,e) = thermalStateResiduum(s,g,i,e) / thermalState(p)%dotState(s,c) -#endif !$OMP FLUSH(relStateResiduum) #ifndef _OPENMP -#ifndef NEWSTATE - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & - .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& - .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g - write(6,*) - write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> absolute residuum tolerance', & - stateResiduum(1:mySizeDotState,g,i,e) / constitutive_aTolState(g,i,e)%p(1:mySizeDotState) - write(6,*) - write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> relative residuum tolerance', & - relStateResiduum(1:mySizeDotState,g,i,e) / rTol_crystalliteState - write(6,*) - write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - - 2.0_pReal * stateResiduum(1:mySizeDotState,g,i,e) / crystallite_subdt(g,i,e) ! calculate former dotstate from higher order solution and state residuum - write(6,*) - write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) - write(6,*) - endif -#else + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -2941,22 +2610,9 @@ subroutine crystallite_integrateStateAdaptiveEuler() - 2.0_pReal * stateResiduum(1:mySizePlasticDotState,g,i,e) / crystallite_subdt(g,i,e) ! calculate former dotstate from higher order solution and state residuum write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', plasticState(p)%State(1:mySizePlasticDotState,c) endif -#endif #endif ! --- converged ? --- -#ifndef NEWSTATE - if ( all( abs(relStateResiduum(1:mySizeDotState,g,i,e)) < rTol_crystalliteState & - .or. abs(stateResiduum(1:mySizeDotState,g,i,e)) < constitutive_aTolState(g,i,e)%p(1:mySizeDotState))) then - crystallite_converged(g,i,e) = .true. ! ... converged per definitionem - if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (distributionState) - debug_StateLoopDistribution(2,numerics_integrationMode) = & - debug_StateLoopDistribution(2,numerics_integrationMode) + 1_pInt - !$OMP END CRITICAL (distributionState) - endif - endif -#else if ( all(abs(relStateResiduum(1:mySizePlasticDotState,g,i,e)) < & rTol_crystalliteState .or. & abs(stateResiduum(1:mySizePlasticDotState,g,i,e)) < & @@ -2977,7 +2633,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() !$OMP END CRITICAL (distributionState) endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -3038,31 +2693,20 @@ subroutine crystallite_integrateStateEuler() mesh_element, & mesh_NcpElems use material, only: & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_Ngrains use constitutive, only: & constitutive_collectDotState, & -#ifndef NEWSTATE - constitutive_subState0, & - constitutive_state, & - constitutive_sizeDotState, & - constitutive_maxSizeDotState, & - constitutive_dotState, & -#endif constitutive_microstructure -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_collectDotState, & constitutive_damage_microstructure use constitutive_thermal, only: & constitutive_thermal_collectDotState, & constitutive_thermal_microstructure -#endif implicit none @@ -3104,31 +2748,18 @@ eIter = FEsolving_execElem(1:2) call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), crystallite_Fe, & crystallite_Fp, crystallite_temperature(i,e), & crystallite_subdt(g,i,e), crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif enddo; enddo; enddo !$OMP ENDDO !$OMP DO PRIVATE(p,c) do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p/=constitutive_dotState(g,i,e)%p) ) then ! NaN occured in dotState - if (.not. crystallite_localPlasticity(g,i,e) .and. .not. numerics_timeSyncing) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif -#else c = mappingConstitutive(1,g,i,e) p = mappingConstitutive(2,g,i,e) if ( any(plasticState(p)%dotState(:,c) /= plasticState(p)%dotState(:,c)) .or.& @@ -3142,7 +2773,6 @@ eIter = FEsolving_execElem(1:2) crystallite_todo(g,i,e) = .false. ! ... skip this one next time endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -3153,12 +2783,6 @@ eIter = FEsolving_execElem(1:2) !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,c) 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) .and. .not. crystallite_converged(g,i,e)) then -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_state(g,i,e)%p(1:mySizeDotState) & - + constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - * crystallite_subdt(g,i,e) -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -3173,17 +2797,18 @@ eIter = FEsolving_execElem(1:2) thermalState(p)%State(1:mySizeThermalDotState,c) = thermalState(p)%subState0(1:mySizeThermalDotState,c) & + thermalState(p)%dotState (1:mySizeThermalDotState,c) & * crystallite_subdt(g,i,e) -#endif -!#ifndef _OPENMP -! if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & -! .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & -! .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then -! write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST >> update state at el ip g ',e,i,g -! write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) -! write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) -! endif -!#endif +#ifndef _OPENMP +#ifdef TODO + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & + .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & + .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then + write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST >> update state at el ip g ',e,i,g + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', constitutive_state(g,i,e)%p(1:mySizeDotState) + endif +#endif +#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -3215,14 +2840,12 @@ eIter = FEsolving_execElem(1:2) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) & call constitutive_microstructure(crystallite_temperature(i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states -#ifdef NEWSTATE call constitutive_damage_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states call constitutive_thermal_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states -#endif enddo; enddo; enddo !$OMP ENDDO !$OMP END PARALLEL @@ -3305,27 +2928,15 @@ subroutine crystallite_integrateStateFPI() mesh_element, & mesh_NcpElems use material, only: & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_Ngrains use constitutive, only: & constitutive_collectDotState, & constitutive_microstructure, & -#ifndef NEWSTATE - constitutive_subState0, & - constitutive_state, & - constitutive_sizeDotState, & - constitutive_dotState, & - constitutive_previousDotState, & - constitutive_previousDotState2, & - constitutive_aTolState, & -#endif constitutive_maxSizeDotState -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_collectDotState, & constitutive_damage_microstructure, & @@ -3334,9 +2945,7 @@ subroutine crystallite_integrateStateFPI() constitutive_thermal_collectDotState, & constitutive_thermal_microstructure, & constitutive_thermal_maxSizeDotState -#endif - - + implicit none integer(pInt) :: & @@ -3365,14 +2974,12 @@ subroutine crystallite_integrateStateFPI() real(pReal), dimension(constitutive_maxSizeDotState) :: & stateResiduum, & tempState -#ifdef NEWSTATE real(pReal), dimension(constitutive_damage_maxSizeDotState) :: & damageStateResiduum, & ! residuum from evolution in micrstructure tempDamageState real(pReal), dimension(constitutive_thermal_maxSizeDotState) :: & thermalStateResiduum, & ! residuum from evolution in micrstructure tempThermalState -#endif logical :: & singleRun, & ! flag indicating computation for single (g,i,e) triple doneWithIntegration @@ -3385,7 +2992,6 @@ subroutine crystallite_integrateStateFPI() singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) -#ifdef NEWSTATE !-------------------------------------------------------------------------------------------------- ! initialize dotState if (.not. singleRun) then @@ -3415,32 +3021,24 @@ subroutine crystallite_integrateStateFPI() thermalState(p)%previousDotState2(:,c) = 0.0_pReal enddo endif -#endif ! --+>> PREGUESS FOR STATE <<+-- ! --- DOT STATES --- !$OMP PARALLEL - !$OMP DO do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains -#ifndef NEWSTATE - constitutive_previousDotState(g,i,e)%p = 0.0_pReal - constitutive_previousDotState2(g,i,e)%p = 0.0_pReal -#endif if (crystallite_todo(g,i,e)) then call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), crystallite_Fe, & crystallite_Fp, crystallite_temperature(i,e), & crystallite_subdt(g,i,e), crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -3448,17 +3046,6 @@ subroutine crystallite_integrateStateFPI() do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p/=constitutive_dotState(g,i,e)%p) ) then ! NaN occured in dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken is a non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals done (and broken) - !$OMP END CRITICAL (checkTodo) - else ! broken one was local... - crystallite_todo(g,i,e) = .false. ! ... done (and broken) - endif - endif -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) if ( any(plasticState(p)%dotState(:,c) /= plasticState(p)%dotState(:,c)) .or.& @@ -3472,7 +3059,6 @@ subroutine crystallite_integrateStateFPI() crystallite_todo(g,i,e) = .false. ! ... done (and broken) endif endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -3483,12 +3069,6 @@ subroutine crystallite_integrateStateFPI() !$OMP DO PRIVATE(mySizeDotState,mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState,p,c) 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 -#ifndef NEWSTATE - mySizeDotState = constitutive_sizeDotState(g,i,e) - constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_subState0(g,i,e)%p(1:mySizeDotState) & - + constitutive_dotState(g,i,e)%p(1:mySizeDotState) & - * crystallite_subdt(g,i,e) -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -3503,7 +3083,6 @@ subroutine crystallite_integrateStateFPI() thermalState(p)%State(1:mySizeThermalDotState,c) = thermalState(p)%subState0(1:mySizeThermalDotState,c) & + thermalState(p)%dotState (1:mySizeThermalDotState,c) & * crystallite_subdt(g,i,e) -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -3527,10 +3106,6 @@ subroutine crystallite_integrateStateFPI() if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) & call constitutive_microstructure(crystallite_temperature(i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states -#ifndef NEWSTATE - constitutive_previousDotState2(g,i,e)%p = constitutive_previousDotState(g,i,e)%p ! remember previous dotState - constitutive_previousDotState(g,i,e)%p = constitutive_dotState(g,i,e)%p ! remember current dotState -#else call constitutive_damage_microstructure(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & g,i,e) ! update dependent state variables to be consistent with basic states @@ -3545,7 +3120,6 @@ subroutine crystallite_integrateStateFPI() damageState(p)%previousDotState(:,c) = damageState(p)%dotState(:,c) thermalState(p)%previousDotState2(:,c) = thermalState(p)%previousDotState(:,c) thermalState(p)%previousDotState(:,c) = thermalState(p)%dotState(:,c) -#endif enddo; enddo; enddo !$OMP ENDDO @@ -3584,30 +3158,18 @@ subroutine crystallite_integrateStateFPI() call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), crystallite_Fe, & crystallite_Fp, crystallite_temperature(i,e), & crystallite_subdt(g,i,e), crystallite_subFrac, g,i,e) -#ifdef NEWSTATE call constitutive_damage_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) call constitutive_thermal_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Lp(1:3,1:3,g,i,e), & g,i,e) -#endif enddo; enddo; enddo !$OMP ENDDO !$OMP DO PRIVATE(p,c) do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then -#ifndef NEWSTATE - if ( any(constitutive_dotState(g,i,e)%p/=constitutive_dotState(g,i,e)%p) ) then ! NaN occured in dotState - crystallite_todo(g,i,e) = .false. ! ... skip me next time - if (.not. crystallite_localPlasticity(g,i,e)) then ! if me is non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) if ( any(plasticState(p)%dotState(:,c) /= plasticState(p)%dotState(:,c)) .or.& @@ -3620,7 +3182,6 @@ subroutine crystallite_integrateStateFPI() !$OMP END CRITICAL (checkTodo) endif endif -#endif endif @@ -3632,44 +3193,13 @@ subroutine crystallite_integrateStateFPI() ! --- UPDATE STATE --- !$OMP DO PRIVATE(dot_prod12,dot_prod22, & -#ifdef NEWSTATE !$OMP& mySizePlasticDotState,mySizeDamageDotState,mySizeThermalDotState, & !$OMP& damageStateResiduum,thermalStateResiduum,damageStateDamper,thermalStateDamper, & !$OMP& tempDamageState,tempThermalState,p,c, & -#endif !$OMP& statedamper,mySizeDotState,stateResiduum,tempState) 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) .and. .not. crystallite_converged(g,i,e)) then -#ifndef NEWSTATE - ! --- state damper --- - - dot_prod12 = dot_product( constitutive_dotState(g,i,e)%p - constitutive_previousDotState(g,i,e)%p, & - constitutive_previousDotState(g,i,e)%p - constitutive_previousDotState2(g,i,e)%p ) - dot_prod22 = dot_product( constitutive_previousDotState(g,i,e)%p - constitutive_previousDotState2(g,i,e)%p, & - constitutive_previousDotState(g,i,e)%p - constitutive_previousDotState2(g,i,e)%p ) - - if ( dot_prod22 > 0.0_pReal & - .and. ( dot_prod12 < 0.0_pReal & - .or. dot_product(constitutive_dotState(g,i,e)%p, constitutive_previousDotState(g,i,e)%p) < 0.0_pReal) ) then - statedamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - statedamper = 1.0_pReal - endif - ! --- get residui --- - - mySizeDotState = constitutive_sizeDotState(g,i,e) - stateResiduum(1:mySizeDotState) = constitutive_state(g,i,e)%p(1:mySizeDotState) & - - constitutive_subState0(g,i,e)%p(1:mySizeDotState) & - - (constitutive_dotState(g,i,e)%p(1:mySizeDotState) * statedamper & - + constitutive_previousDotState(g,i,e)%p(1:mySizeDotState) & - * (1.0_pReal - statedamper)) * crystallite_subdt(g,i,e) - - ! --- correct state with residuum --- - tempState(1:mySizeDotState) = constitutive_state(g,i,e)%p(1:mySizeDotState) & - - stateResiduum(1:mySizeDotState) ! need to copy to local variable, since we cant flush a pointer in openmp - -#else p = mappingConstitutive(2,g,i,e) c = mappingConstitutive(1,g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState @@ -3747,8 +3277,6 @@ subroutine crystallite_integrateStateFPI() - damageStateResiduum(1:mySizeDamageDotState) ! need to copy to local variable, since we cant flush a pointer in openmp tempThermalState(1:mySizeThermalDotState) = thermalState(p)%state(1:mySizeThermalDotState,c) & - thermalStateResiduum(1:mySizeThermalDotState) ! need to copy to local variable, since we cant flush a pointer in openmp - -#endif #ifndef _OPENMP if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & @@ -3761,27 +3289,7 @@ subroutine crystallite_integrateStateFPI() #endif ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) -#ifndef NEWSTATE - constitutive_dotState(g,i,e)%p = constitutive_dotState(g,i,e)%p * statedamper & - + constitutive_previousDotState(g,i,e)%p & - * (1.0_pReal - statedamper) - ! --- converged ? --- - - if ( all( abs(stateResiduum(1:mySizeDotState)) < constitutive_aTolState(g,i,e)%p(1:mySizeDotState) & - .or. abs(stateResiduum(1:mySizeDotState)) < rTol_crystalliteState & - * abs(tempState(1:mySizeDotState)) ) ) then - crystallite_converged(g,i,e) = .true. ! ... converged per definitionem - if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (distributionState) - debug_StateLoopDistribution(NiterationState,numerics_integrationMode) = & - debug_StateLoopDistribution(NiterationState,numerics_integrationMode) + 1_pInt - !$OMP END CRITICAL (distributionState) - endif - endif - constitutive_state(g,i,e)%p(1:mySizeDotState) = tempState(1:mySizeDotState) ! copy local backup to global pointer - -#else plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) & * (1.0_pReal - stateDamper) @@ -3813,7 +3321,6 @@ subroutine crystallite_integrateStateFPI() plasticState(p)%state(1:mySizePlasticDotState,c) = tempState(1:mySizePlasticDotState) ! copy local backup to global pointer damageState(p)%state (1:mySizeDamageDotState, c) = tempDamageState(1:mySizeDamageDotState) ! copy local backup to global pointer thermalState(p)%state(1:mySizeThermalDotState,c) = tempThermalState(1:mySizeThermalDotState) ! copy local backup to global pointer -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -3895,28 +3402,14 @@ logical function crystallite_stateJump(g,i,e) mesh_element, & mesh_NcpElems use material, only: & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_Ngrains use constitutive, only: & -#ifndef NEWSTATE - constitutive_sizeDotState, & - constitutive_state, & - constitutive_deltaState, & -#endif - constitutive_collectDeltaState -#ifdef NEWSTATE - use constitutive_damage, only: & - constitutive_damage_collectDeltaState - use constitutive_thermal, only: & - constitutive_thermal_collectDeltaState -#endif - - + constitutive_collectDeltaState + implicit none integer(pInt), intent(in):: & e, & ! element index @@ -3930,45 +3423,18 @@ logical function crystallite_stateJump(g,i,e) mySizePlasticDotState, & mySizeDamageDotState, & mySizeThermalDotState - - -#ifdef NEWSTATE + c = mappingConstitutive(1,g,i,e) p = mappingConstitutive(2,g,i,e) -#endif - if ( & -#ifdef NEWSTATE - constitutive_thermal_collectDeltaState(g,i,e) .and. & - constitutive_damage_collectDeltaState(g,i,e) .and. & -#endif - constitutive_collectDeltaState(crystallite_Tstar_v(1:6,g,i,e), g,i,e)) then -#ifdef NEWSTATE + if (constitutive_collectDeltaState(crystallite_Tstar_v(1:6,g,i,e), g,i,e)) then mySizePlasticDotState = plasticState(p)%sizeDotState - mySizeDamageDotState = damageState(p)%sizeDotState - mySizeThermalDotState = thermalState(p)%sizeDotState - if( any(plasticState(p)%deltaState(:,c) /= plasticState(p)%deltaState(:,c)) .or. & - any(damageState(p)%deltaState(:,c) /= damageState(p)%deltaState(:,c)) .or. & - any(thermalState(p)%deltaState(:,c) /= thermalState(p)%deltaState(:,c))) then ! NaN occured in deltaState + if( any(plasticState(p)%deltaState(:,c) /= plasticState(p)%deltaState(:,c))) then ! NaN occured in deltaState crystallite_stateJump = .false. return endif plasticState(p)%state(1:mySizePlasticDotState,c) = plasticState(p)%state(1:mySizePlasticDotState,c) + & plasticState(p)%deltaState(1:mySizePlasticDotState,c) - damageState(p)%state(1:mySizeDamageDotState,c) = damageState(p)%state(1:mySizeDamageDotState,c) + & - damageState(p)%deltaState(1:mySizeDamageDotState,c) - thermalState(p)%state(1:mySizeThermalDotState,c) = thermalState(p)%state(1:mySizeThermalDotState,c) + & - thermalState(p)%deltaState(1:mySizeThermalDotState,c) -#else - mySizeDotState = constitutive_sizeDotState(g,i,e) - if (any(constitutive_deltaState(g,i,e)%p(1:mySizeDotState) & - /= constitutive_deltaState(g,i,e)%p(1:mySizeDotState))) then - crystallite_stateJump = .false. - return - endif - - constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_state(g,i,e)%p(1:mySizeDotState) & - + constitutive_deltaState(g,i,e)%p(1:mySizeDotState) - +#ifdef TODO #ifndef _OPENMP if (any(constitutive_deltaState(g,i,e)%p(1:mySizeDotState) /= 0.0_pReal) & .and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & @@ -4358,10 +3824,9 @@ subroutine crystallite_orientations use lattice, only: & lattice_qDisorientation, & lattice_structure -#ifndef NEWSTATE use constitutive_nonlocal, only: & constitutive_nonlocal_updateCompatibility -#endif + implicit none integer(pInt) & @@ -4387,13 +3852,13 @@ subroutine crystallite_orientations do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) - - !$OMP CRITICAL (polarDecomp) ! somehow this subroutine is not threadsafe, so need critical statement here; not clear, what exactly the problem is - call math_pDecomposition(crystallite_Fe(1:3,1:3,g,i,e), U, R, error) ! polar decomposition of Fe +! somehow this subroutine is not threadsafe, so need critical statement here; not clear, what exactly the problem is + !$OMP CRITICAL (polarDecomp) + call math_pDecomposition(crystallite_Fe(1:3,1:3,g,i,e), U, R, error) ! polar decomposition of Fe !$OMP END CRITICAL (polarDecomp) if (error) then call IO_warning(650_pInt, e, i, g) - orientation = [1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal] ! fake orientation + orientation = [1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal] ! fake orientation else orientation = math_RtoQ(transpose(R)) endif @@ -4412,8 +3877,7 @@ subroutine crystallite_orientations !$OMP PARALLEL DO PRIVATE(myPhase,neighboring_e,neighboring_i,neighboringPhase) 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 -#ifndef NEWSTATE + myPhase = material_phase(1,i,e) ! get my phase if (.not. phase_localPlasticity(myPhase)) then ! if nonlocal model ! --- calculate disorientation between me and my neighbor --- @@ -4445,15 +3909,12 @@ subroutine crystallite_orientations call constitutive_nonlocal_updateCompatibility(crystallite_orientation,i,e) endif -#endif enddo enddo !$OMP END PARALLEL DO end subroutine crystallite_orientations - - !-------------------------------------------------------------------------------------------------- !> @brief return results of particular grain !-------------------------------------------------------------------------------------------------- @@ -4479,28 +3940,22 @@ function crystallite_postResults(ipc, ip, el) FE_geomtype, & FE_celltype use material, only: & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & -#endif microstructure_crystallite, & crystallite_Noutput, & material_phase, & material_texture, & homogenization_Ngrains use constitutive, only: & -#ifndef NEWSTATE constitutive_sizePostResults, & -#endif constitutive_postResults, & constitutive_homogenizedC -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_postResults use constitutive_thermal, only: & constitutive_thermal_postResults -#endif implicit none integer(pInt), intent(in):: & @@ -4509,13 +3964,9 @@ function crystallite_postResults(ipc, ip, el) ipc !< grain index real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(mesh_element(4,el)))+ & -#ifdef NEWSTATE 1+plasticState(material_phase(ipc,ip,el))%sizePostResults + & 1+damageState(material_phase(ipc,ip,el))%sizePostResults + & - 1+thermalState(material_phase(ipc,ip,el))%sizePostResults) :: & -#else - 1+constitutive_sizePostResults(ipc,ip,el)) :: & -#endif + 1+thermalState(material_phase(ipc,ip,el))%sizePostResults) :: & crystallite_postResults real(pReal), dimension(3,3) :: & Ee @@ -4633,15 +4084,6 @@ function crystallite_postResults(ipc, ip, el) c = c + mySize enddo -#ifndef NEWSTATE - crystallite_postResults(c+1) = real(constitutive_sizePostResults(ipc,ip,el),pReal) ! size of constitutive results - c = c + 1_pInt - if (constitutive_sizePostResults(ipc,ip,el) > 0_pInt) & - crystallite_postResults(c+1:c+constitutive_sizePostResults(ipc,ip,el)) = & - constitutive_postResults(crystallite_Tstar_v(1:6,ipc,ip,el), crystallite_Fe, & - crystallite_temperature(ip,el), ipc, ip, el) - c = c + constitutive_sizePostResults(ipc,ip,el) -#else crystallite_postResults(c+1) = real(plasticState(material_phase(ipc,ip,el))%sizePostResults,pReal) ! size of constitutive results c = c + 1_pInt if (plasticState(material_phase(ipc,ip,el))%sizePostResults > 0_pInt) & @@ -4663,7 +4105,7 @@ function crystallite_postResults(ipc, ip, el) crystallite_postResults(c+1:c+thermalState(material_phase(ipc,ip,el))%sizePostResults) = & constitutive_thermal_postResults(ipc, ip, el) c = c + thermalState(material_phase(ipc,ip,el))%sizePostResults -#endif + end function crystallite_postResults diff --git a/code/damage_gradient.f90 b/code/damage_gradient.f90 index 12d009053..71de21a09 100644 --- a/code/damage_gradient.f90 +++ b/code/damage_gradient.f90 @@ -14,8 +14,6 @@ module damage_gradient implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - damage_gradient_sizeDotState, & !< number of dotStates - damage_gradient_sizeState, & !< total number of microstructural state variables damage_gradient_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -112,8 +110,6 @@ subroutine damage_gradient_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(damage_gradient_sizeDotState(maxNinstance), source=0_pInt) - allocate(damage_gradient_sizeState(maxNinstance), source=0_pInt) allocate(damage_gradient_sizePostResults(maxNinstance), source=0_pInt) allocate(damage_gradient_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) allocate(damage_gradient_output(maxval(phase_Noutput),maxNinstance)) @@ -168,8 +164,6 @@ subroutine damage_gradient_init(fileUnit) if (phase_damage(phase) == DAMAGE_gradient_ID) then NofMyPhase=count(material_phase==phase) instance = phase_damageInstance(phase) - damage_gradient_sizeDotState(instance) = 1_pInt - damage_gradient_sizeState(instance) = 3_pInt !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array @@ -187,8 +181,8 @@ subroutine damage_gradient_init(fileUnit) endif enddo outputsLoop ! Determine size of state array - sizeDotState = damage_gradient_sizeDotState(instance) - sizeState = damage_gradient_sizeState (instance) + sizeDotState = 1_pInt + sizeState = 3_pInt damageState(phase)%sizeState = sizeState damageState(phase)%sizeDotState = sizeDotState diff --git a/code/damage_none.f90 b/code/damage_none.f90 index 74e2340ad..0f4d54e29 100644 --- a/code/damage_none.f90 +++ b/code/damage_none.f90 @@ -12,8 +12,6 @@ module damage_none implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - damage_none_sizeDotState, & - damage_none_sizeState, & damage_none_sizePostResults integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -69,10 +67,9 @@ subroutine damage_none_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance -#ifdef NEWSTATE initializeInstances: do phase = 1_pInt, size(phase_damage) NofMyPhase=count(material_phase==phase) - if (phase_damage(phase) == DAMAGE_none_ID .and. NofMyPhase/=0) then + if (phase_damage(phase) == DAMAGE_none_ID) then sizeState = 0_pInt damageState(phase)%sizeState = sizeState sizeDotState = sizeState @@ -95,10 +92,7 @@ subroutine damage_none_init(fileUnit) allocate(damageState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) endif enddo initializeInstances -#else - allocate(damage_none_sizeDotState(maxNinstance), source=1_pInt) - allocate(damage_none_sizeState(maxNinstance), source=1_pInt) -#endif + allocate(damage_none_sizePostResults(maxNinstance), source=0_pInt) end subroutine damage_none_init diff --git a/code/homogenization.f90 b/code/homogenization.f90 index 8ba973297..bfe5dd888 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -104,12 +104,10 @@ subroutine homogenization_init() FE_geomtype use constitutive, only: & constitutive_maxSizePostResults -#ifdef NEWSTATE use constitutive_damage, only: & constitutive_damage_maxSizePostResults use constitutive_thermal, only: & constitutive_thermal_maxSizePostResults -#endif use crystallite, only: & crystallite_maxSizePostResults use material @@ -239,10 +237,8 @@ subroutine homogenization_init() materialpoint_sizeResults = 1 & ! grain count + 1 + homogenization_maxSizePostResults & ! homogSize & homogResult + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results -#ifdef NEWSTATE + 1 + constitutive_damage_maxSizePostResults & + 1 + constitutive_thermal_maxSizePostResults & -#endif + 1 + constitutive_maxSizePostResults) ! constitutive size & constitutive results allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) @@ -302,19 +298,12 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) mesh_NcpElems, & mesh_maxNips use material, only: & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & mappingConstitutive, & -#endif homogenization_Ngrains -#ifndef NEWSTATE - use constitutive, only: & - constitutive_state0, & - constitutive_partionedState0, & - constitutive_state -#endif + use crystallite, only: & crystallite_heat, & @@ -380,16 +369,12 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(mesh_element(3,e)) forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), g = 1:myNgrains) -#ifdef NEWSTATE plasticState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%state0(:,mappingConstitutive(1,g,i,e)) damageState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) = & damageState(mappingConstitutive(2,g,i,e))%state0(:,mappingConstitutive(1,g,i,e)) thermalState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%state0(:,mappingConstitutive(1,g,i,e)) -#else - constitutive_partionedState0(g,i,e)%p = constitutive_state0(g,i,e)%p ! ...microstructures -#endif crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) ! ...plastic def grads crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) ! ...plastic velocity grads crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,g,i,e) = crystallite_dPdF0(1:3,1:3,1:3,1:3,g,i,e) ! ...stiffness @@ -444,7 +429,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) = crystallite_Lp(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e)! ...stiffness crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) = crystallite_Tstar_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress -#ifdef NEWSTATE forall (g = 1:myNgrains) plasticState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) @@ -453,10 +437,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) thermalState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) end forall -#else - - forall (g = 1:myNgrains) constitutive_partionedState0(g,i,e)%p = constitutive_state(g,i,e)%p ! ...microstructures -#endif if (homogenization_sizeState(i,e) > 0_pInt) & homogenization_subState0(i,e)%p = homogenization_state(i,e)%p ! ...internal state of homog scheme materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad @@ -503,7 +483,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) ! ...stiffness crystallite_Tstar_v(1:6,1:myNgrains,i,e) = crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress -#ifdef NEWSTATE forall (g = 1:myNgrains) plasticState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & plasticState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) @@ -512,10 +491,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) thermalState(mappingConstitutive(2,g,i,e))%state(:,mappingConstitutive(1,g,i,e)) = & thermalState(mappingConstitutive(2,g,i,e))%partionedState0(:,mappingConstitutive(1,g,i,e)) end forall -#else - - forall (g = 1:myNgrains) constitutive_state(g,i,e)%p = constitutive_partionedState0(g,i,e)%p ! ...microstructures -#endif if (homogenization_sizeState(i,e) > 0_pInt) & homogenization_state(i,e)%p = homogenization_subState0(i,e)%p ! ...internal state of homog scheme endif @@ -631,18 +606,13 @@ subroutine materialpoint_postResults use mesh, only: & mesh_element use material, only: & -#ifdef NEWSTATE plasticState, & damageState, & thermalState, & material_phase, & -#endif homogenization_Ngrains, & microstructure_crystallite use constitutive, only: & -#ifndef NEWSTATE - constitutive_sizePostResults, & -#endif constitutive_postResults use crystallite, only: & crystallite_sizePostResults, & @@ -679,13 +649,9 @@ subroutine materialpoint_postResults grainLooping :do g = 1,myNgrains theSize = (1 + crystallite_sizePostResults(myCrystallite)) + & -#ifdef NEWSTATE (1 + plasticState(material_phase(g,i,e))%sizePostResults) + & (1 + damageState(material_phase(g,i,e))%sizePostResults) + & (1 + thermalState(material_phase(g,i,e))%sizePostResults) -#else - (1 + constitutive_sizePostResults(g,i,e)) -#endif materialpoint_results(thePos+1:thePos+theSize,i,e) = crystallite_postResults(g,i,e) ! tell crystallite results thePos = thePos + theSize enddo grainLooping diff --git a/code/lattice.f90 b/code/lattice.f90 index c70ad5584..43d0bc989 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -635,14 +635,12 @@ module lattice real(pReal), dimension(:), allocatable, public, protected :: & lattice_mu, & lattice_nu -#ifdef NEWSTATE real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_thermalConductivity33, & lattice_thermalExpansion33, & lattice_surfaceEnergy33 real(pReal), dimension(:), allocatable, public, protected :: & lattice_referenceTemperature -#endif enum, bind(c) enumerator :: LATTICE_undefined_ID, & LATTICE_iso_ID, & @@ -864,12 +862,10 @@ subroutine lattice_init allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(lattice_C66(6,6,Nphases), source=0.0_pReal) allocate(lattice_C3333(3,3,3,3,Nphases), source=0.0_pReal) -#ifdef NEWSTATE allocate(lattice_thermalConductivity33(3,3,Nphases), source=0.0_pReal) allocate(lattice_thermalExpansion33 (3,3,Nphases), source=0.0_pReal) allocate(lattice_surfaceEnergy33 (3,3,Nphases), source=0.0_pReal) allocate(lattice_referenceTemperature (Nphases), source=0.0_pReal) -#endif allocate(lattice_mu(Nphases), source=0.0_pReal) allocate(lattice_nu(Nphases), source=0.0_pReal) @@ -955,7 +951,6 @@ subroutine lattice_init lattice_C66(6,6,section) = IO_floatValue(line,positions,2_pInt) case ('covera_ratio','c/a_ratio','c/a') CoverA(section) = IO_floatValue(line,positions,2_pInt) -#ifdef NEWSTATE case ('k11') lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,positions,2_pInt) case ('k22') @@ -976,7 +971,6 @@ subroutine lattice_init lattice_surfaceEnergy33(3,3,section) = IO_floatValue(line,positions,2_pInt) case ('reference_temperature') lattice_referenceTemperature(section) = IO_floatValue(line,positions,2_pInt) -#endif end select endif enddo @@ -1048,14 +1042,12 @@ subroutine lattice_initializeStructure(myPhase,CoverA) do i = 1_pInt, 6_pInt if (abs(lattice_C66(i,i,myPhase)) @brief Symmetrizes 2nd order tensor according to lattice type !-------------------------------------------------------------------------------------------------- @@ -1298,7 +1288,6 @@ pure function lattice_symmetrize33(struct,T33) end select end function lattice_symmetrize33 -#endif !-------------------------------------------------------------------------------------------------- diff --git a/code/material.f90 b/code/material.f90 index b292e5171..4ebebc98f 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -12,9 +12,7 @@ module material use prec, only: & pReal, & pInt, & -#ifdef NEWSTATE tState, & -#endif p_intvec implicit none @@ -51,7 +49,6 @@ module material PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID end enum -#ifdef NEWSTATE enum, bind(c) enumerator :: DAMAGE_none_ID, & DAMAGE_local_ID, & @@ -63,7 +60,6 @@ module material THERMAL_conduction_ID, & THERMAL_adiabatic_ID end enum -#endif enum, bind(c) enumerator :: HOMOGENIZATION_undefined_ID, & HOMOGENIZATION_none_ID, & @@ -84,12 +80,11 @@ module material phase_elasticity !< elasticity of each phase integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & phase_plasticity !< plasticity of each phase -#ifdef NEWSTATE integer(kind(DAMAGE_none_ID)), dimension(:), allocatable, public, protected :: & phase_damage !< damage of each phase integer(kind(THERMAL_none_ID)), dimension(:), allocatable, public, protected :: & phase_thermal !< thermal of each phase -#endif + integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & homogenization_type !< type of each homogenization @@ -111,10 +106,8 @@ module material phase_Noutput, & !< number of '(output)' items per phase phase_elasticityInstance, & !< instance of particular elasticity of each phase phase_plasticityInstance, & !< instance of particular plasticity of each phase -#ifdef NEWSTATE - phase_damageInstance, & !< instance of particular plasticity of each phase - phase_thermalInstance, & !< instance of particular plasticity of each phase -#endif + phase_damageInstance, & !< instance of particular damage of each phase + phase_thermalInstance, & !< instance of particular thermal 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 @@ -122,13 +115,12 @@ module material integer(pInt), dimension(:,:,:), allocatable, public :: & material_phase !< phase (index) of each grain,IP,element -#ifdef NEWSTATE type(tState), allocatable, dimension(:), public :: & plasticState, & elasticState, & damageState, & thermalState -#endif + integer(pInt), dimension(:,:,:), allocatable, public, protected :: & material_texture !< texture (index) of each grain,IP,element @@ -181,12 +173,11 @@ module material logical, dimension(:), allocatable, private :: & homogenization_active -#if defined(HDF) || defined(NEWSTATE) integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: mappingConstitutive integer(pInt), dimension(:,:,:), allocatable, public, protected :: mappingCrystallite integer(pInt), dimension(:), allocatable :: ConstitutivePosition integer(pInt), dimension(:), allocatable :: CrystallitePosition -#endif + public :: & material_init, & @@ -197,7 +188,6 @@ module material PLASTICITY_dislotwin_ID, & PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID, & -#ifdef NEWSTATE DAMAGE_none_ID, & DAMAGE_local_ID, & DAMAGE_gradient_ID, & @@ -205,7 +195,6 @@ module material THERMAL_iso_ID, & THERMAL_conduction_ID, & THERMAL_adiabatic_ID, & -#endif HOMOGENIZATION_none_ID, & HOMOGENIZATION_isostrain_ID, & #ifdef HDF @@ -276,12 +265,11 @@ subroutine material_init call material_parsePhase(FILEUNIT,material_partPhase) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed' close(FILEUNIT) -#ifdef NEWSTATE + allocate(plasticState(material_Nphase)) allocate(elasticState(material_Nphase)) allocate(damageState (material_Nphase)) allocate(thermalState(material_Nphase)) -#endif do m = 1_pInt,material_Nmicrostructure if(microstructure_crystallite(m) < 1_pInt .or. & @@ -321,7 +309,6 @@ subroutine material_init call material_populateGrains -#if defined(HDF) || defined(NEWSTATE) allocate(mappingConstitutive(2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(mappingCrystallite (2,homogenization_maxNgrains,mesh_NcpElems),source=0_pInt) allocate(ConstitutivePosition(material_Nphase),source=0_pInt) @@ -335,7 +322,6 @@ subroutine material_init enddo GrainLoop enddo IPloop enddo ElemLoop -#endif end subroutine material_init @@ -632,12 +618,10 @@ subroutine material_parsePhase(fileUnit,myPart) allocate(phase_elasticityInstance(Nsections), source=0_pInt) allocate(phase_plasticity(Nsections) , source=PLASTICITY_undefined_ID) allocate(phase_plasticityInstance(Nsections), source=0_pInt) -#ifdef NEWSTATE allocate(phase_damage(Nsections) , source=DAMAGE_none_ID) allocate(phase_damageInstance(Nsections), source=0_pInt) allocate(phase_thermal(Nsections) , source=THERMAL_none_ID) allocate(phase_thermalInstance(Nsections), source=0_pInt) -#endif allocate(phase_Noutput(Nsections), source=0_pInt) allocate(phase_localPlasticity(Nsections), source=.false.) @@ -694,7 +678,6 @@ subroutine material_parsePhase(fileUnit,myPart) call IO_error(201_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) end select phase_plasticityInstance(section) = count(phase_plasticity == phase_plasticity(section)) ! count instances -#ifdef NEWSTATE case ('damage') select case (IO_lc(IO_stringValue(line,positions,2_pInt))) case (DAMAGE_NONE_label) @@ -721,7 +704,6 @@ subroutine material_parsePhase(fileUnit,myPart) call IO_error(200_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) end select phase_thermalInstance(section) = count(phase_thermal == phase_thermal(section)) ! count instances -#endif end select endif enddo diff --git a/code/prec.f90 b/code/prec.f90 index 8588cd965..e04f858de 100644 --- a/code/prec.f90 +++ b/code/prec.f90 @@ -57,10 +57,11 @@ module prec integer(pInt), dimension(:), allocatable :: p end type p_intvec -#ifdef NEWSTATE !http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array type, public :: tState - integer(pInt) :: sizeState,sizeDotState,sizePostResults + integer(pInt) :: sizeState = 0_pInt , & + sizeDotState = 0_pInt, & + sizePostResults = 0_pInt logical :: nonlocal real(pReal), allocatable, dimension(:) :: atolState real(pReal), allocatable, dimension(:,:) :: state, & ! material points, state size @@ -76,7 +77,6 @@ module prec RK4dotState real(pReal), allocatable, dimension(:,:,:) :: RKCK45dotState end type -#endif public :: & prec_init @@ -96,9 +96,6 @@ subroutine prec_init write(6,'(/,a)') ' <<<+- prec init -+>>>' write(6,'(a)') ' $Id$' #include "compilation_info.f90" -#ifdef NEWSTATE - write(6,'(a)') 'Using new state structure' -#endif write(6,'(a,i3)') ' Bytes for pReal: ',pReal write(6,'(a,i3)') ' Bytes for pInt: ',pInt write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt diff --git a/code/thermal_adiabatic.f90 b/code/thermal_adiabatic.f90 index 0a98cba97..2b598b726 100644 --- a/code/thermal_adiabatic.f90 +++ b/code/thermal_adiabatic.f90 @@ -14,8 +14,6 @@ module thermal_adiabatic implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - thermal_adiabatic_sizeDotState, & !< number of dotStates - thermal_adiabatic_sizeState, & !< total number of microstructural state variables thermal_adiabatic_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -111,8 +109,6 @@ subroutine thermal_adiabatic_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(thermal_adiabatic_sizeDotState(maxNinstance), source=0_pInt) - allocate(thermal_adiabatic_sizeState(maxNinstance), source=0_pInt) allocate(thermal_adiabatic_sizePostResults(maxNinstance), source=0_pInt) allocate(thermal_adiabatic_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) allocate(thermal_adiabatic_output(maxval(phase_Noutput),maxNinstance)) @@ -165,8 +161,6 @@ subroutine thermal_adiabatic_init(fileUnit) if (phase_thermal(phase) == THERMAL_adiabatic_ID) then NofMyPhase=count(material_phase==phase) instance = phase_thermalInstance(phase) - thermal_adiabatic_sizeDotState(instance) = 1_pInt - thermal_adiabatic_sizeState(instance) = 1_pInt !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array @@ -182,9 +176,8 @@ subroutine thermal_adiabatic_init(fileUnit) endif enddo outputsLoop ! Determine size of state array - sizeDotState = thermal_adiabatic_sizeDotState(instance) - sizeState = thermal_adiabatic_sizeState (instance) - + sizeDotState = 1_pInt + sizeState = 1_pInt thermalState(phase)%sizeState = sizeState thermalState(phase)%sizeDotState = sizeDotState allocate(thermalState(phase)%aTolState (sizeState), source=0.0_pReal) diff --git a/code/thermal_conduction.f90 b/code/thermal_conduction.f90 index b11ebd51d..4789ff097 100644 --- a/code/thermal_conduction.f90 +++ b/code/thermal_conduction.f90 @@ -14,8 +14,6 @@ module thermal_conduction implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - thermal_conduction_sizeDotState, & !< number of dotStates - thermal_conduction_sizeState, & !< total number of microstructural state variables thermal_conduction_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -111,8 +109,6 @@ subroutine thermal_conduction_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(thermal_conduction_sizeDotState(maxNinstance), source=0_pInt) - allocate(thermal_conduction_sizeState(maxNinstance), source=0_pInt) allocate(thermal_conduction_sizePostResults(maxNinstance), source=0_pInt) allocate(thermal_conduction_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) allocate(thermal_conduction_output(maxval(phase_Noutput),maxNinstance)) @@ -165,8 +161,6 @@ subroutine thermal_conduction_init(fileUnit) if (phase_thermal(phase) == THERMAL_conduction_ID) then NofMyPhase=count(material_phase==phase) instance = phase_thermalInstance(phase) - thermal_conduction_sizeDotState(instance) = 0_pInt - thermal_conduction_sizeState(instance) = 2_pInt !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array @@ -182,8 +176,8 @@ subroutine thermal_conduction_init(fileUnit) endif enddo outputsLoop ! Determine size of state array - sizeDotState = thermal_conduction_sizeDotState(instance) - sizeState = thermal_conduction_sizeState (instance) + sizeDotState = 0_pInt + sizeState = 2_pInt thermalState(phase)%sizeState = sizeState thermalState(phase)%sizeDotState = sizeDotState @@ -195,7 +189,7 @@ subroutine thermal_conduction_init(fileUnit) allocate(thermalState(phase)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) allocate(thermalState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(thermalState(phase)%deltaState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(thermalState(phase)%deltaState (sizeDotState,NofMyPhase), source=0.0_pReal) allocate(thermalState(phase)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then allocate(thermalState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) diff --git a/code/thermal_none.f90 b/code/thermal_none.f90 index f757b9880..82c7859eb 100644 --- a/code/thermal_none.f90 +++ b/code/thermal_none.f90 @@ -12,8 +12,6 @@ module thermal_none implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - thermal_none_sizeDotState, & - thermal_none_sizeState, & thermal_none_sizePostResults integer(pInt), dimension(:,:), allocatable, target, public :: & @@ -68,8 +66,7 @@ subroutine thermal_none_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - -#ifdef NEWSTATE + initializeInstances: do phase = 1_pInt, size(phase_thermal) NofMyPhase=count(material_phase==phase) if (phase_thermal(phase) == THERMAL_none_ID .and. NofMyPhase/=0) then @@ -95,10 +92,6 @@ subroutine thermal_none_init(fileUnit) allocate(thermalState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) endif enddo initializeInstances -#else - allocate(thermal_none_sizeDotState(maxNinstance), source=1_pInt) - allocate(thermal_none_sizeState(maxNinstance), source=1_pInt) -#endif allocate(thermal_none_sizePostResults(maxNinstance), source=0_pInt) end subroutine thermal_none_init