diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90
index 18fcc4945..54c84632e 100644
--- a/code/constitutive_dislotwin.f90
+++ b/code/constitutive_dislotwin.f90
@@ -16,294 +16,324 @@
! You should have received a copy of the GNU General Public License
! along with DAMASK. If not, see .
!
-!##############################################################
-!* $Id$
-!************************************
-!* Module: CONSTITUTIVE *
-!************************************
+!--------------------------------------------------------------------------------------------------
+! $Id$
+!--------------------------------------------------------------------------------------------------
+!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
+!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
+!> @brief material subroutine incoprorating dislocation and twinning physics
+!> @details to be done
+!--------------------------------------------------------------------------------------------------
+module constitutive_dislotwin
+use prec, only: &
+ pReal, &
+ pInt
-MODULE constitutive_dislotwin
-
-!* Include other modules
-use prec, only: pReal,pInt
-implicit none
-
-!* Lists of states and physical parameters
-character(len=*), parameter, public :: constitutive_dislotwin_LABEL = 'dislotwin'
-character(len=18), dimension(3), parameter:: constitutive_dislotwin_listBasicSlipStates = (/'rhoEdge ', &
- 'rhoEdgeDip ', &
- 'accshearslip'/)
-character(len=18), dimension(2), parameter:: constitutive_dislotwin_listBasicTwinStates = (/'twinFraction', &
- 'accsheartwin'/)
-character(len=18), dimension(4), parameter:: constitutive_dislotwin_listDependentSlipStates =(/'invLambdaSlip ', &
- 'invLambdaSlipTwin', &
- 'meanFreePathSlip ', &
- 'tauSlipThreshold '/)
-character(len=18), dimension(4), parameter:: constitutive_dislotwin_listDependentTwinStates =(/'invLambdaTwin ', &
- 'meanFreePathTwin', &
- 'tauTwinThreshold', &
- 'twinVolume '/)
-real(pReal), parameter :: kB = 1.38e-23_pReal ! Boltzmann constant in J/Kelvin
-
-!* Definition of global variables
-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
-integer(pInt), dimension(:,:), allocatable, target, public :: &
- constitutive_dislotwin_sizePostResult ! size of each post result output
-character(len=64), dimension(:,:), allocatable, target, public :: &
- constitutive_dislotwin_output ! name of each post result output
-integer(pInt), dimension(:), allocatable :: constitutive_dislotwin_Noutput ! number of outputs per instance of this plasticity
-character(len=32), dimension(:), allocatable, public, protected :: constitutive_dislotwin_structureName ! name of the lattice structure
-integer(pInt), dimension(:), allocatable :: constitutive_dislotwin_structure, & ! number representing the kind of lattice structure
- constitutive_dislotwin_totalNslip, & ! total number of active slip systems for each instance
- constitutive_dislotwin_totalNtwin ! total number of active twin systems for each instance
-integer(pInt), dimension(:,:), allocatable :: constitutive_dislotwin_Nslip, & ! number of active slip systems for each family and instance
- constitutive_dislotwin_Ntwin ! number of active twin systems for each family and instance
-real(pReal), dimension(:), allocatable :: constitutive_dislotwin_CoverA, & ! c/a ratio for hex type lattice
- constitutive_dislotwin_Gmod, & ! shear modulus
- constitutive_dislotwin_nu, & ! poisson's ratio
- constitutive_dislotwin_CAtomicVolume, & ! atomic volume in Bugers vector unit
- constitutive_dislotwin_D0, & ! prefactor for self-diffusion coefficient
- constitutive_dislotwin_Qsd, & ! activation energy for dislocation climb
- constitutive_dislotwin_GrainSize, & ! grain size
- constitutive_dislotwin_p, & ! p-exponent in glide velocity
- constitutive_dislotwin_q, & ! q-exponent in glide velocity
- constitutive_dislotwin_MaxTwinFraction, & ! maximum allowed total twin volume fraction
- constitutive_dislotwin_r, & ! r-exponent in twin nucleation rate
- constitutive_dislotwin_CEdgeDipMinDistance, & !
- constitutive_dislotwin_Cmfptwin, & !
- constitutive_dislotwin_Cthresholdtwin, & !
- constitutive_dislotwin_SolidSolutionStrength, & ! Strength due to elements in solid solution
- constitutive_dislotwin_L0, & ! Length of twin nuclei in Burgers vectors
- constitutive_dislotwin_xc, & ! critical distance for formation of twin nucleus
- constitutive_dislotwin_VcrossSlip, & ! cross slip volume
- constitutive_dislotwin_sbResistance, & ! value for shearband resistance (might become an internal state variable at some point)
- constitutive_dislotwin_sbVelocity, & ! value for shearband velocity_0
- constitutive_dislotwin_sbQedge, & ! value for shearband systems Qedge
- constitutive_dislotwin_SFE_0K, & ! stacking fault energy at zero K
- constitutive_dislotwin_dSFE_dT, & ! temperature dependance of stacking fault energy
- constitutive_dislotwin_aTolRho, & ! absolute tolerance for integration of dislocation density
- constitutive_dislotwin_aTolTwinFrac ! absolute tolerance for integration of twin volume fraction
-real(pReal), dimension(:,:,:), allocatable :: &
- constitutive_dislotwin_Cslip_66 ! elasticity matrix in Mandel notation for each instance
-real(pReal), dimension(:,:,:,:), allocatable :: &
- constitutive_dislotwin_Ctwin_66 ! twin elasticity matrix in Mandel notation for each instance
-real(pReal), dimension(:,:,:,:,:), allocatable :: &
- constitutive_dislotwin_Cslip_3333 ! elasticity matrix for each instance
-real(pReal), dimension(:,:,:,:,:,:), allocatable :: &
- constitutive_dislotwin_Ctwin_3333 ! twin elasticity matrix for each instance
-real(pReal), dimension(:,:), allocatable :: &
- constitutive_dislotwin_rhoEdge0, & ! initial edge dislocation density per slip system for each family and instance
- constitutive_dislotwin_rhoEdgeDip0, & ! initial edge dipole density per slip system for each family and instance
- constitutive_dislotwin_burgersPerSlipFamily, & ! absolute length of burgers vector [m] for each slip family and instance
- constitutive_dislotwin_burgersPerSlipSystem, & ! absolute length of burgers vector [m] for each slip system and instance
- constitutive_dislotwin_burgersPerTwinFamily, & ! absolute length of burgers vector [m] for each twin family and instance
- constitutive_dislotwin_burgersPerTwinSystem, & ! absolute length of burgers vector [m] for each twin system and instance
- constitutive_dislotwin_QedgePerSlipFamily, & ! activation energy for glide [J] for each slip family and instance
- constitutive_dislotwin_QedgePerSlipSystem, & ! activation energy for glide [J] for each slip system and instance
- constitutive_dislotwin_v0PerSlipFamily, & ! dislocation velocity prefactor [m/s] for each family and instance
- constitutive_dislotwin_v0PerSlipSystem, & ! dislocation velocity prefactor [m/s] for each slip system and instance
- constitutive_dislotwin_Ndot0PerTwinFamily, & ! twin nucleation rate [1/m³s] for each twin family and instance
- constitutive_dislotwin_Ndot0PerTwinSystem, & ! twin nucleation rate [1/m³s] for each twin system and instance
- constitutive_dislotwin_tau_r, & ! stress to bring partial close together for each twin system and instance
- constitutive_dislotwin_twinsizePerTwinFamily, & ! twin thickness [m] for each twin family and instance
- constitutive_dislotwin_twinsizePerTwinSystem, & ! twin thickness [m] for each twin system and instance
- constitutive_dislotwin_CLambdaSlipPerSlipFamily, & ! Adj. parameter for distance between 2 forest dislocations for each slip family and instance
- constitutive_dislotwin_CLambdaSlipPerSlipSystem, & ! Adj. parameter for distance between 2 forest dislocations for each slip system and instance
- constitutive_dislotwin_interaction_SlipSlip, & ! coefficients for slip-slip interaction for each interaction type and instance
- constitutive_dislotwin_interaction_SlipTwin, & ! coefficients for slip-twin interaction for each interaction type and instance
- constitutive_dislotwin_interaction_TwinSlip, & ! coefficients for twin-slip interaction for each interaction type and instance
- constitutive_dislotwin_interaction_TwinTwin ! coefficients for twin-twin interaction for each interaction type and instance
-real(pReal), dimension(:,:,:), allocatable :: &
- constitutive_dislotwin_interactionMatrix_SlipSlip, & ! interaction matrix of the different slip systems for each instance
- constitutive_dislotwin_interactionMatrix_SlipTwin, & ! interaction matrix of slip systems with twin systems for each instance
- constitutive_dislotwin_interactionMatrix_TwinSlip, & ! interaction matrix of twin systems with slip systems for each instance
- constitutive_dislotwin_interactionMatrix_TwinTwin, & ! interaction matrix of the different twin systems for each instance
- constitutive_dislotwin_forestProjectionEdge ! matrix of forest projections of edge dislocations for each instance
-real(pReal), dimension(:,:,:,:,:), allocatable :: constitutive_dislotwin_sbSv
-
-!****************************************
-public :: constitutive_dislotwin_microstructure, &
- constitutive_dislotwin_init, &
- constitutive_dislotwin_stateInit, &
- constitutive_dislotwin_homogenizedC, &
- constitutive_dislotwin_LpAndItsTangent, &
- constitutive_dislotwin_dotState, &
- constitutive_dislotwin_deltaState, &
- constitutive_dislotwin_dotTemperature, &
- constitutive_dislotwin_postResults, &
- constitutive_dislotwin_aTolState
-!****************************************
-
-CONTAINS
-
-subroutine constitutive_dislotwin_init(file)
-!**************************************
-!* Module initialization *
-!**************************************
-use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
-use prec, only: pInt,pReal
-use debug, only: debug_level,&
- debug_constitutive,&
- debug_levelBasic
-use math, only: math_Mandel3333to66,math_Voigt66to3333,math_mul3x3
-use mesh, only: mesh_maxNips, mesh_NcpElems
-use IO
-use material
-use lattice
-
-!* Input variables
-integer(pInt), intent(in) :: file
-!* Local variables
- integer(pInt), parameter :: MAXNCHUNKS = lattice_maxNinteraction + 1_pInt
-integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions
-integer(pInt), dimension(7) :: configNchunks
-integer(pInt) :: section = 0_pInt, maxNinstance,mySize=0_pInt,myStructure,maxTotalNslip,maxTotalNtwin,&
- f,i,j,k,l,m,n,o,p,q,r,s,ns,nt, &
- Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, &
- Nchunks_SlipFamilies, Nchunks_TwinFamilies, &
- index_myFamily, index_otherFamily
-character(len=65536) :: tag
-character(len=65536) :: line = '' ! to start initialized
+ implicit none
+ private
+ character(len=*), parameter, public :: &
+ CONSTITUTIVE_DISLOTWIN_label = 'dislotwin'
+ 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
+
+ character(len=32), dimension(:), allocatable, public, protected :: &
+ constitutive_dislotwin_structureName !< name of the lattice structure
+
+ integer(pInt), dimension(:,:), allocatable, target, public :: &
+ constitutive_dislotwin_sizePostResult !< size of each post result output
+
+ character(len=64), dimension(:,:), allocatable, target, public :: &
+ constitutive_dislotwin_output !< name of each post result output
+
+ character(len=12), dimension(3), parameter, private :: &
+ CONSTITUTIVE_DISLOTWIN_listBasicSlipStates = &
+ ['rhoEdge ', 'rhoEdgeDip ', 'accshearslip']
+
+ character(len=12), dimension(2), parameter, private :: &
+ CONSTITUTIVE_DISLOTWIN_listBasicTwinStates = &
+ ['twinFraction', 'accsheartwin']
+
+ character(len=17), dimension(4), parameter, private :: &
+ CONSTITUTIVE_DISLOTWIN_listDependentSlipStates = &
+ ['invLambdaSlip ', 'invLambdaSlipTwin', 'meanFreePathSlip ', 'tauSlipThreshold ']
+
+ character(len=16), dimension(4), parameter, private :: &
+ CONSTITUTIVE_DISLOTWIN_listDependentTwinStates = &
+ ['invLambdaTwin ', 'meanFreePathTwin', 'tauTwinThreshold', 'twinVolume ']
+
+ real(pReal), parameter, private :: &
+ kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin
+
+ integer(pInt), dimension(:), allocatable, private :: &
+ constitutive_dislotwin_Noutput !< number of outputs per instance of this plasticity
+
+ integer(pInt), dimension(:), allocatable, private :: &
+ constitutive_dislotwin_structure, & !< number representing the kind of lattice structure
+ constitutive_dislotwin_totalNslip, & !< total number of active slip systems for each instance
+ constitutive_dislotwin_totalNtwin !< total number of active twin systems for each instance
+
+ integer(pInt), dimension(:,:), allocatable, private :: &
+ constitutive_dislotwin_Nslip, & !< number of active slip systems for each family and instance
+ constitutive_dislotwin_Ntwin !< number of active twin systems for each family and instance
+
+ real(pReal), dimension(:), allocatable, private :: &
+ constitutive_dislotwin_CoverA, & !< c/a ratio for hex type lattice
+ constitutive_dislotwin_Gmod, & !< shear modulus
+ constitutive_dislotwin_nu, & !< poisson's ratio
+ constitutive_dislotwin_CAtomicVolume, & !< atomic volume in Bugers vector unit
+ constitutive_dislotwin_D0, & !< prefactor for self-diffusion coefficient
+ constitutive_dislotwin_Qsd, & !< activation energy for dislocation climb
+ constitutive_dislotwin_GrainSize, & !< grain size
+ constitutive_dislotwin_p, & !< p-exponent in glide velocity
+ constitutive_dislotwin_q, & !< q-exponent in glide velocity
+ constitutive_dislotwin_MaxTwinFraction, & !< maximum allowed total twin volume fraction
+ constitutive_dislotwin_r, & !< r-exponent in twin nucleation rate
+ constitutive_dislotwin_CEdgeDipMinDistance, & !<
+ constitutive_dislotwin_Cmfptwin, & !<
+ constitutive_dislotwin_Cthresholdtwin, & !<
+ constitutive_dislotwin_SolidSolutionStrength, & !< Strength due to elements in solid solution
+ constitutive_dislotwin_L0, & !< Length of twin nuclei in Burgers vectors
+ constitutive_dislotwin_xc, & !< critical distance for formation of twin nucleus
+ constitutive_dislotwin_VcrossSlip, & !< cross slip volume
+ constitutive_dislotwin_sbResistance, & !< value for shearband resistance (might become an internal state variable at some point)
+ constitutive_dislotwin_sbVelocity, & !< value for shearband velocity_0
+ constitutive_dislotwin_sbQedge, & !< value for shearband systems Qedge
+ constitutive_dislotwin_SFE_0K, & !< stacking fault energy at zero K
+ constitutive_dislotwin_dSFE_dT, & !< temperature dependance of stacking fault energy
+ constitutive_dislotwin_aTolRho, & !< absolute tolerance for integration of dislocation density
+ constitutive_dislotwin_aTolTwinFrac !< absolute tolerance for integration of twin volume fraction
+
+ real(pReal), dimension(:,:,:), allocatable, private :: &
+ constitutive_dislotwin_Cslip_66 !< elasticity matrix in Mandel notation for each instance
+
+ real(pReal), dimension(:,:,:,:), allocatable, private :: &
+ constitutive_dislotwin_Ctwin_66 !< twin elasticity matrix in Mandel notation for each instance
+
+ real(pReal), dimension(:,:,:,:,:), allocatable, private :: &
+ constitutive_dislotwin_Cslip_3333 !< elasticity matrix for each instance
+
+ real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: &
+ constitutive_dislotwin_Ctwin_3333 !< twin elasticity matrix for each instance
+
+ real(pReal), dimension(:,:), allocatable, private :: &
+ constitutive_dislotwin_rhoEdge0, & !< initial edge dislocation density per slip system for each family and instance
+ constitutive_dislotwin_rhoEdgeDip0, & !< initial edge dipole density per slip system for each family and instance
+ constitutive_dislotwin_burgersPerSlipFamily, & !< absolute length of burgers vector [m] for each slip family and instance
+ constitutive_dislotwin_burgersPerSlipSystem, & !< absolute length of burgers vector [m] for each slip system and instance
+ constitutive_dislotwin_burgersPerTwinFamily, & !< absolute length of burgers vector [m] for each twin family and instance
+ constitutive_dislotwin_burgersPerTwinSystem, & !< absolute length of burgers vector [m] for each twin system and instance
+ constitutive_dislotwin_QedgePerSlipFamily, & !< activation energy for glide [J] for each slip family and instance
+ constitutive_dislotwin_QedgePerSlipSystem, & !< activation energy for glide [J] for each slip system and instance
+ constitutive_dislotwin_v0PerSlipFamily, & !< dislocation velocity prefactor [m/s] for each family and instance
+ constitutive_dislotwin_v0PerSlipSystem, & !< dislocation velocity prefactor [m/s] for each slip system and instance
+ constitutive_dislotwin_Ndot0PerTwinFamily, & !< twin nucleation rate [1/m³s] for each twin family and instance
+ constitutive_dislotwin_Ndot0PerTwinSystem, & !< twin nucleation rate [1/m³s] for each twin system and instance
+ constitutive_dislotwin_tau_r, & !< stress to bring partial close together for each twin system and instance
+ constitutive_dislotwin_twinsizePerTwinFamily, & !< twin thickness [m] for each twin family and instance
+ constitutive_dislotwin_twinsizePerTwinSystem, & !< twin thickness [m] for each twin system and instance
+ constitutive_dislotwin_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance
+ constitutive_dislotwin_CLambdaSlipPerSlipSystem, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance
+ constitutive_dislotwin_interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance
+ constitutive_dislotwin_interaction_SlipTwin, & !< coefficients for slip-twin interaction for each interaction type and instance
+ constitutive_dislotwin_interaction_TwinSlip, & !< coefficients for twin-slip interaction for each interaction type and instance
+ constitutive_dislotwin_interaction_TwinTwin !< coefficients for twin-twin interaction for each interaction type and instance
+ real(pReal), dimension(:,:,:), allocatable, private :: &
+ constitutive_dislotwin_interactionMatrix_SlipSlip, & !< interaction matrix of the different slip systems for each instance
+ constitutive_dislotwin_interactionMatrix_SlipTwin, & !< interaction matrix of slip systems with twin systems for each instance
+ constitutive_dislotwin_interactionMatrix_TwinSlip, & !< interaction matrix of twin systems with slip systems for each instance
+ constitutive_dislotwin_interactionMatrix_TwinTwin, & !< interaction matrix of the different twin systems for each instance
+ constitutive_dislotwin_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance
+ real(pReal), dimension(:,:,:,:,:), allocatable, private :: &
+ constitutive_dislotwin_sbSv
+
+
+ public :: &
+ constitutive_dislotwin_init, &
+ constitutive_dislotwin_stateInit, &
+ constitutive_dislotwin_aTolState, &
+ constitutive_dislotwin_homogenizedC, &
+ constitutive_dislotwin_microstructure, &
+ constitutive_dislotwin_LpAndItsTangent, &
+ constitutive_dislotwin_dotState, &
+ constitutive_dislotwin_deltaState, &
+ constitutive_dislotwin_dotTemperature, &
+ constitutive_dislotwin_postResults
+
+contains
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief module initialization
+!> @details reads in material parameters, allocates arrays, and does sanity checks
+!--------------------------------------------------------------------------------------------------
+subroutine constitutive_dislotwin_init(file)
+ use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
+ use debug, only: &
+ debug_level,&
+ debug_constitutive,&
+ debug_levelBasic
+ use math, only: &
+ math_Mandel3333to66, &
+ math_Voigt66to3333, &
+ math_mul3x3
+ use mesh, only: &
+ mesh_maxNips, &
+ mesh_NcpElems
+ use IO
+ use material
+ use lattice
+
+ implicit none
+ integer(pInt), intent(in) :: file
+
+ integer(pInt), parameter :: maxNchunks = 21_pInt
+ integer(pInt), dimension(1+2*maxNchunks) :: positions
+ integer(pInt), dimension(7) :: configNchunks
+ integer(pInt) :: section = 0_pInt, maxNinstance,mySize=0_pInt,structID,maxTotalNslip,maxTotalNtwin,&
+ f,i,j,k,l,m,n,o,p,q,r,s,ns,nt, &
+ Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, &
+ Nchunks_SlipFamilies, Nchunks_TwinFamilies, &
+ index_myFamily, index_otherFamily
+ character(len=65536) :: tag
+ character(len=65536) :: line = '' ! to start initialized
+
write(6,'(/,a)') ' <<<+- constitutive_'//trim(constitutive_dislotwin_LABEL)//' init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
-
-maxNinstance = int(count(phase_plasticity == constitutive_dislotwin_label),pInt)
-if (maxNinstance == 0_pInt) return
-
-if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
- write(6,'(a16,1x,i5)') '# instances:',maxNinstance
- write(6,*)
-endif
-
-Nchunks_SlipFamilies = lattice_maxNslipFamily
-Nchunks_TwinFamilies = lattice_maxNtwinFamily
-Nchunks_SlipSlip = lattice_maxNinteraction
-Nchunks_SlipTwin = lattice_maxNinteraction
-Nchunks_TwinSlip = lattice_maxNinteraction
-Nchunks_TwinTwin = lattice_maxNinteraction
-
-!* Space allocation for global variables
-allocate(constitutive_dislotwin_sizeDotState(maxNinstance))
- constitutive_dislotwin_sizeDotState = 0_pInt
-allocate(constitutive_dislotwin_sizeState(maxNinstance))
- constitutive_dislotwin_sizeState = 0_pInt
-allocate(constitutive_dislotwin_sizePostResults(maxNinstance))
- constitutive_dislotwin_sizePostResults = 0_pInt
-allocate(constitutive_dislotwin_sizePostResult(maxval(phase_Noutput),maxNinstance))
- constitutive_dislotwin_sizePostResult = 0_pInt
-allocate(constitutive_dislotwin_output(maxval(phase_Noutput),maxNinstance))
- constitutive_dislotwin_output = ''
-allocate(constitutive_dislotwin_Noutput(maxNinstance))
- constitutive_dislotwin_Noutput = 0_pInt
-
-allocate(constitutive_dislotwin_structureName(maxNinstance))
- constitutive_dislotwin_structureName = ''
-allocate(constitutive_dislotwin_structure(maxNinstance))
- constitutive_dislotwin_structure = 0_pInt
-allocate(constitutive_dislotwin_Nslip(lattice_maxNslipFamily,maxNinstance))
- constitutive_dislotwin_Nslip = 0_pInt
-allocate(constitutive_dislotwin_Ntwin(lattice_maxNtwinFamily,maxNinstance))
- constitutive_dislotwin_Ntwin = 0_pInt
-allocate(constitutive_dislotwin_totalNslip(maxNinstance))
- constitutive_dislotwin_totalNslip = 0_pInt
-allocate(constitutive_dislotwin_totalNtwin(maxNinstance))
- constitutive_dislotwin_totalNtwin = 0_pInt
-allocate(constitutive_dislotwin_CoverA(maxNinstance))
- constitutive_dislotwin_CoverA = 0.0_pReal
-allocate(constitutive_dislotwin_Gmod(maxNinstance))
- constitutive_dislotwin_Gmod = 0.0_pReal
-allocate(constitutive_dislotwin_nu(maxNinstance))
- constitutive_dislotwin_nu = 0.0_pReal
-allocate(constitutive_dislotwin_CAtomicVolume(maxNinstance))
- constitutive_dislotwin_CAtomicVolume = 0.0_pReal
-allocate(constitutive_dislotwin_D0(maxNinstance))
- constitutive_dislotwin_D0 = 0.0_pReal
-allocate(constitutive_dislotwin_Qsd(maxNinstance))
- constitutive_dislotwin_Qsd = 0.0_pReal
-allocate(constitutive_dislotwin_GrainSize(maxNinstance))
- constitutive_dislotwin_GrainSize = 0.0_pReal
-allocate(constitutive_dislotwin_p(maxNinstance))
- constitutive_dislotwin_p = 0.0_pReal
-allocate(constitutive_dislotwin_q(maxNinstance))
- constitutive_dislotwin_q = 0.0_pReal
-allocate(constitutive_dislotwin_MaxTwinFraction(maxNinstance))
- constitutive_dislotwin_MaxTwinFraction = 0.0_pReal
-allocate(constitutive_dislotwin_r(maxNinstance))
- constitutive_dislotwin_r = 0.0_pReal
-allocate(constitutive_dislotwin_CEdgeDipMinDistance(maxNinstance))
- constitutive_dislotwin_CEdgeDipMinDistance = 0.0_pReal
-allocate(constitutive_dislotwin_Cmfptwin(maxNinstance))
- constitutive_dislotwin_Cmfptwin = 0.0_pReal
-allocate(constitutive_dislotwin_Cthresholdtwin(maxNinstance))
- constitutive_dislotwin_Cthresholdtwin = 0.0_pReal
-allocate(constitutive_dislotwin_SolidSolutionStrength(maxNinstance))
- constitutive_dislotwin_SolidSolutionStrength = 0.0_pReal
-allocate(constitutive_dislotwin_L0(maxNinstance))
- constitutive_dislotwin_L0 = 0.0_pReal
-allocate(constitutive_dislotwin_xc(maxNinstance))
- constitutive_dislotwin_xc = 0.0_pReal
-allocate(constitutive_dislotwin_VcrossSlip(maxNinstance))
- constitutive_dislotwin_VcrossSlip = 0.0_pReal
-allocate(constitutive_dislotwin_aTolRho(maxNinstance))
- constitutive_dislotwin_aTolRho = 0.0_pReal
-allocate(constitutive_dislotwin_aTolTwinFrac(maxNinstance))
- constitutive_dislotwin_aTolTwinFrac = 0.0_pReal
-allocate(constitutive_dislotwin_Cslip_66(6,6,maxNinstance))
- constitutive_dislotwin_Cslip_66 = 0.0_pReal
-allocate(constitutive_dislotwin_Cslip_3333(3,3,3,3,maxNinstance))
- constitutive_dislotwin_Cslip_3333 = 0.0_pReal
-allocate(constitutive_dislotwin_sbResistance(maxNinstance))
- constitutive_dislotwin_sbResistance = 0.0_pReal
-allocate(constitutive_dislotwin_sbVelocity(maxNinstance))
- constitutive_dislotwin_sbVelocity = 0.0_pReal
-allocate(constitutive_dislotwin_sbQedge(maxNinstance))
- constitutive_dislotwin_sbQedge = 0.0_pReal
-allocate(constitutive_dislotwin_SFE_0K(maxNinstance))
- constitutive_dislotwin_SFE_0K = 0.0_pReal
-allocate(constitutive_dislotwin_dSFE_dT(maxNinstance))
- constitutive_dislotwin_dSFE_dT = 0.0_pReal
-allocate(constitutive_dislotwin_rhoEdge0(lattice_maxNslipFamily,maxNinstance))
- constitutive_dislotwin_rhoEdge0 = 0.0_pReal
-allocate(constitutive_dislotwin_rhoEdgeDip0(lattice_maxNslipFamily,maxNinstance))
- constitutive_dislotwin_rhoEdgeDip0 = 0.0_pReal
-allocate(constitutive_dislotwin_burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstance))
- constitutive_dislotwin_burgersPerSlipFamily = 0.0_pReal
-allocate(constitutive_dislotwin_burgersPerTwinFamily(lattice_maxNtwinFamily,maxNinstance))
- constitutive_dislotwin_burgersPerTwinFamily = 0.0_pReal
-allocate(constitutive_dislotwin_QedgePerSlipFamily(lattice_maxNslipFamily,maxNinstance))
- constitutive_dislotwin_QedgePerSlipFamily = 0.0_pReal
-allocate(constitutive_dislotwin_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance))
- constitutive_dislotwin_v0PerSlipFamily = 0.0_pReal
-allocate(constitutive_dislotwin_Ndot0PerTwinFamily(lattice_maxNtwinFamily,maxNinstance))
- constitutive_dislotwin_Ndot0PerTwinFamily = 0.0_pReal
-allocate(constitutive_dislotwin_twinsizePerTwinFamily(lattice_maxNtwinFamily,maxNinstance))
- constitutive_dislotwin_twinsizePerTwinFamily = 0.0_pReal
-allocate(constitutive_dislotwin_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance))
- constitutive_dislotwin_CLambdaSlipPerSlipFamily = 0.0_pReal
-allocate(constitutive_dislotwin_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance))
- constitutive_dislotwin_interaction_SlipSlip = 0.0_pReal
-allocate(constitutive_dislotwin_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance))
- constitutive_dislotwin_interaction_SlipTwin = 0.0_pReal
-allocate(constitutive_dislotwin_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance))
- constitutive_dislotwin_interaction_TwinSlip = 0.0_pReal
-allocate(constitutive_dislotwin_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance))
- constitutive_dislotwin_interaction_TwinTwin = 0.0_pReal
-allocate(constitutive_dislotwin_sbSv(6,6,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
- constitutive_dislotwin_sbSv = 0.0_pReal
-
-!* Readout data from material.config file
-rewind(file)
-
+
+ maxNinstance = int(count(phase_plasticity == constitutive_dislotwin_label),pInt)
+ if (maxNinstance == 0_pInt) return
+
+ if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
+ write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
+
+ Nchunks_SlipFamilies = lattice_maxNslipFamily
+ Nchunks_TwinFamilies = lattice_maxNtwinFamily
+ Nchunks_SlipSlip = lattice_maxNinteraction
+ Nchunks_SlipTwin = lattice_maxNinteraction
+ Nchunks_TwinSlip = lattice_maxNinteraction
+ Nchunks_TwinTwin = lattice_maxNinteraction
+
+ !* Space allocation for global variables
+ allocate(constitutive_dislotwin_sizeDotState(maxNinstance))
+ constitutive_dislotwin_sizeDotState = 0_pInt
+ allocate(constitutive_dislotwin_sizeState(maxNinstance))
+ constitutive_dislotwin_sizeState = 0_pInt
+ allocate(constitutive_dislotwin_sizePostResults(maxNinstance))
+ constitutive_dislotwin_sizePostResults = 0_pInt
+ allocate(constitutive_dislotwin_sizePostResult(maxval(phase_Noutput),maxNinstance))
+ constitutive_dislotwin_sizePostResult = 0_pInt
+ allocate(constitutive_dislotwin_output(maxval(phase_Noutput),maxNinstance))
+ constitutive_dislotwin_output = ''
+ allocate(constitutive_dislotwin_Noutput(maxNinstance))
+ constitutive_dislotwin_Noutput = 0_pInt
+
+ allocate(constitutive_dislotwin_structureName(maxNinstance))
+ constitutive_dislotwin_structureName = ''
+ allocate(constitutive_dislotwin_structure(maxNinstance))
+ constitutive_dislotwin_structure = 0_pInt
+ allocate(constitutive_dislotwin_Nslip(lattice_maxNslipFamily,maxNinstance))
+ constitutive_dislotwin_Nslip = 0_pInt
+ allocate(constitutive_dislotwin_Ntwin(lattice_maxNtwinFamily,maxNinstance))
+ constitutive_dislotwin_Ntwin = 0_pInt
+ allocate(constitutive_dislotwin_totalNslip(maxNinstance))
+ constitutive_dislotwin_totalNslip = 0_pInt
+ allocate(constitutive_dislotwin_totalNtwin(maxNinstance))
+ constitutive_dislotwin_totalNtwin = 0_pInt
+ allocate(constitutive_dislotwin_CoverA(maxNinstance))
+ constitutive_dislotwin_CoverA = 0.0_pReal
+ allocate(constitutive_dislotwin_Gmod(maxNinstance))
+ constitutive_dislotwin_Gmod = 0.0_pReal
+ allocate(constitutive_dislotwin_nu(maxNinstance))
+ constitutive_dislotwin_nu = 0.0_pReal
+ allocate(constitutive_dislotwin_CAtomicVolume(maxNinstance))
+ constitutive_dislotwin_CAtomicVolume = 0.0_pReal
+ allocate(constitutive_dislotwin_D0(maxNinstance))
+ constitutive_dislotwin_D0 = 0.0_pReal
+ allocate(constitutive_dislotwin_Qsd(maxNinstance))
+ constitutive_dislotwin_Qsd = 0.0_pReal
+ allocate(constitutive_dislotwin_GrainSize(maxNinstance))
+ constitutive_dislotwin_GrainSize = 0.0_pReal
+ allocate(constitutive_dislotwin_p(maxNinstance))
+ constitutive_dislotwin_p = 0.0_pReal
+ allocate(constitutive_dislotwin_q(maxNinstance))
+ constitutive_dislotwin_q = 0.0_pReal
+ allocate(constitutive_dislotwin_MaxTwinFraction(maxNinstance))
+ constitutive_dislotwin_MaxTwinFraction = 0.0_pReal
+ allocate(constitutive_dislotwin_r(maxNinstance))
+ constitutive_dislotwin_r = 0.0_pReal
+ allocate(constitutive_dislotwin_CEdgeDipMinDistance(maxNinstance))
+ constitutive_dislotwin_CEdgeDipMinDistance = 0.0_pReal
+ allocate(constitutive_dislotwin_Cmfptwin(maxNinstance))
+ constitutive_dislotwin_Cmfptwin = 0.0_pReal
+ allocate(constitutive_dislotwin_Cthresholdtwin(maxNinstance))
+ constitutive_dislotwin_Cthresholdtwin = 0.0_pReal
+ allocate(constitutive_dislotwin_SolidSolutionStrength(maxNinstance))
+ constitutive_dislotwin_SolidSolutionStrength = 0.0_pReal
+ allocate(constitutive_dislotwin_L0(maxNinstance))
+ constitutive_dislotwin_L0 = 0.0_pReal
+ allocate(constitutive_dislotwin_xc(maxNinstance))
+ constitutive_dislotwin_xc = 0.0_pReal
+ allocate(constitutive_dislotwin_VcrossSlip(maxNinstance))
+ constitutive_dislotwin_VcrossSlip = 0.0_pReal
+ allocate(constitutive_dislotwin_aTolRho(maxNinstance))
+ constitutive_dislotwin_aTolRho = 0.0_pReal
+ allocate(constitutive_dislotwin_aTolTwinFrac(maxNinstance))
+ constitutive_dislotwin_aTolTwinFrac = 0.0_pReal
+ allocate(constitutive_dislotwin_Cslip_66(6,6,maxNinstance))
+ constitutive_dislotwin_Cslip_66 = 0.0_pReal
+ allocate(constitutive_dislotwin_Cslip_3333(3,3,3,3,maxNinstance))
+ constitutive_dislotwin_Cslip_3333 = 0.0_pReal
+ allocate(constitutive_dislotwin_sbResistance(maxNinstance))
+ constitutive_dislotwin_sbResistance = 0.0_pReal
+ allocate(constitutive_dislotwin_sbVelocity(maxNinstance))
+ constitutive_dislotwin_sbVelocity = 0.0_pReal
+ allocate(constitutive_dislotwin_sbQedge(maxNinstance))
+ constitutive_dislotwin_sbQedge = 0.0_pReal
+ allocate(constitutive_dislotwin_SFE_0K(maxNinstance))
+ constitutive_dislotwin_SFE_0K = 0.0_pReal
+ allocate(constitutive_dislotwin_dSFE_dT(maxNinstance))
+ constitutive_dislotwin_dSFE_dT = 0.0_pReal
+ allocate(constitutive_dislotwin_rhoEdge0(lattice_maxNslipFamily,maxNinstance))
+ constitutive_dislotwin_rhoEdge0 = 0.0_pReal
+ allocate(constitutive_dislotwin_rhoEdgeDip0(lattice_maxNslipFamily,maxNinstance))
+ constitutive_dislotwin_rhoEdgeDip0 = 0.0_pReal
+ allocate(constitutive_dislotwin_burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstance))
+ constitutive_dislotwin_burgersPerSlipFamily = 0.0_pReal
+ allocate(constitutive_dislotwin_burgersPerTwinFamily(lattice_maxNtwinFamily,maxNinstance))
+ constitutive_dislotwin_burgersPerTwinFamily = 0.0_pReal
+ allocate(constitutive_dislotwin_QedgePerSlipFamily(lattice_maxNslipFamily,maxNinstance))
+ constitutive_dislotwin_QedgePerSlipFamily = 0.0_pReal
+ allocate(constitutive_dislotwin_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance))
+ constitutive_dislotwin_v0PerSlipFamily = 0.0_pReal
+ allocate(constitutive_dislotwin_Ndot0PerTwinFamily(lattice_maxNtwinFamily,maxNinstance))
+ constitutive_dislotwin_Ndot0PerTwinFamily = 0.0_pReal
+ allocate(constitutive_dislotwin_twinsizePerTwinFamily(lattice_maxNtwinFamily,maxNinstance))
+ constitutive_dislotwin_twinsizePerTwinFamily = 0.0_pReal
+ allocate(constitutive_dislotwin_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance))
+ constitutive_dislotwin_CLambdaSlipPerSlipFamily = 0.0_pReal
+ allocate(constitutive_dislotwin_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance))
+ constitutive_dislotwin_interaction_SlipSlip = 0.0_pReal
+ allocate(constitutive_dislotwin_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance))
+ constitutive_dislotwin_interaction_SlipTwin = 0.0_pReal
+ allocate(constitutive_dislotwin_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance))
+ constitutive_dislotwin_interaction_TwinSlip = 0.0_pReal
+ allocate(constitutive_dislotwin_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance))
+ constitutive_dislotwin_interaction_TwinTwin = 0.0_pReal
+ allocate(constitutive_dislotwin_sbSv(6,6,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
+ constitutive_dislotwin_sbSv = 0.0_pReal
+
+ !* Readout data from material.config file
+ rewind(file)
+
do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to
line = IO_read(file)
-enddo
-
+ enddo
+
do while (trim(line) /= '#EOF#') ! read thru sections of phase part
line = IO_read(file)
if (IO_isBlank(line)) cycle ! skip empty lines
@@ -314,1521 +344,1563 @@ enddo
endif
if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
if (phase_plasticity(section) == constitutive_dislotwin_LABEL) then ! one of my sections
- i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase
- positions = IO_stringPos(line,MAXNCHUNKS)
- tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
- select case(tag)
- case ('plasticity', 'elasticity')
- cycle
- case ('(output)')
- constitutive_dislotwin_Noutput(i) = constitutive_dislotwin_Noutput(i) + 1_pInt
- constitutive_dislotwin_output(constitutive_dislotwin_Noutput(i),i) = IO_lc(IO_stringValue(line,positions,2_pInt))
- case ('lattice_structure')
- constitutive_dislotwin_structureName(i) = IO_lc(IO_stringValue(line,positions,2_pInt))
- configNchunks = lattice_configNchunks(constitutive_dislotwin_structureName(i))
- Nchunks_SlipFamilies = configNchunks(1)
- Nchunks_TwinFamilies = configNchunks(2)
- Nchunks_SlipSlip = configNchunks(3)
- Nchunks_SlipTwin = configNchunks(4)
- Nchunks_TwinSlip = configNchunks(5)
- Nchunks_TwinTwin = configNchunks(6)
- case ('covera_ratio')
- constitutive_dislotwin_CoverA(i) = IO_floatValue(line,positions,2_pInt)
- case ('c11')
- constitutive_dislotwin_Cslip_66(1,1,i) = IO_floatValue(line,positions,2_pInt)
- case ('c12')
- constitutive_dislotwin_Cslip_66(1,2,i) = IO_floatValue(line,positions,2_pInt)
- case ('c13')
- constitutive_dislotwin_Cslip_66(1,3,i) = IO_floatValue(line,positions,2_pInt)
- case ('c22')
- constitutive_dislotwin_Cslip_66(2,2,i) = IO_floatValue(line,positions,2_pInt)
- case ('c23')
- constitutive_dislotwin_Cslip_66(2,3,i) = IO_floatValue(line,positions,2_pInt)
- case ('c33')
- constitutive_dislotwin_Cslip_66(3,3,i) = IO_floatValue(line,positions,2_pInt)
- case ('c44')
- constitutive_dislotwin_Cslip_66(4,4,i) = IO_floatValue(line,positions,2_pInt)
- case ('c55')
- constitutive_dislotwin_Cslip_66(5,5,i) = IO_floatValue(line,positions,2_pInt)
- case ('c66')
- constitutive_dislotwin_Cslip_66(6,6,i) = IO_floatValue(line,positions,2_pInt)
- case ('nslip')
- if (positions(1) < 1_pInt + Nchunks_SlipFamilies) then
- call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
- endif
- Nchunks_SlipFamilies = positions(1) - 1_pInt
- do j = 1_pInt, Nchunks_SlipFamilies
- constitutive_dislotwin_Nslip(j,i) = IO_intValue(line,positions,1_pInt+j)
- enddo
- case ('ntwin')
- if (positions(1) < 1_pInt + Nchunks_TwinFamilies) then
- call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
- endif
- Nchunks_TwinFamilies = positions(1) - 1_pInt
- do j = 1_pInt, Nchunks_TwinFamilies
- constitutive_dislotwin_Ntwin(j,i) = IO_intValue(line,positions,1_pInt+j)
- enddo
- case ('rhoedge0')
- do j = 1_pInt, Nchunks_SlipFamilies
- constitutive_dislotwin_rhoEdge0(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('rhoedgedip0')
- do j = 1_pInt, Nchunks_SlipFamilies
- constitutive_dislotwin_rhoEdgeDip0(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('slipburgers')
- do j = 1_pInt, Nchunks_SlipFamilies
- constitutive_dislotwin_burgersPerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('twinburgers')
- do j = 1_pInt, Nchunks_TwinFamilies
- constitutive_dislotwin_burgersPerTwinFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('qedge')
- do j = 1_pInt, Nchunks_SlipFamilies
- constitutive_dislotwin_QedgePerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('v0')
- do j = 1_pInt, Nchunks_SlipFamilies
- constitutive_dislotwin_v0PerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('ndot0')
- do j = 1_pInt, Nchunks_TwinFamilies
- constitutive_dislotwin_Ndot0PerTwinFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('twinsize')
- do j = 1_pInt, Nchunks_TwinFamilies
- constitutive_dislotwin_twinsizePerTwinFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('clambdaslip')
- do j = 1_pInt, Nchunks_SlipFamilies
- constitutive_dislotwin_CLambdaSlipPerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('grainsize')
- constitutive_dislotwin_GrainSize(i) = IO_floatValue(line,positions,2_pInt)
- case ('maxtwinfraction')
- constitutive_dislotwin_MaxTwinFraction(i) = IO_floatValue(line,positions,2_pInt)
- case ('pexponent')
- constitutive_dislotwin_p(i) = IO_floatValue(line,positions,2_pInt)
- case ('qexponent')
- constitutive_dislotwin_q(i) = IO_floatValue(line,positions,2_pInt)
- case ('rexponent')
- constitutive_dislotwin_r(i) = IO_floatValue(line,positions,2_pInt)
- case ('d0')
- constitutive_dislotwin_D0(i) = IO_floatValue(line,positions,2_pInt)
- case ('qsd')
- constitutive_dislotwin_Qsd(i) = IO_floatValue(line,positions,2_pInt)
- case ('atol_rho')
- constitutive_dislotwin_aTolRho(i) = IO_floatValue(line,positions,2_pInt)
- case ('atol_twinfrac')
- constitutive_dislotwin_aTolTwinFrac(i) = IO_floatValue(line,positions,2_pInt)
- case ('cmfptwin')
- constitutive_dislotwin_Cmfptwin(i) = IO_floatValue(line,positions,2_pInt)
- case ('cthresholdtwin')
- constitutive_dislotwin_Cthresholdtwin(i) = IO_floatValue(line,positions,2_pInt)
- case ('solidsolutionstrength')
- constitutive_dislotwin_SolidSolutionStrength(i) = IO_floatValue(line,positions,2_pInt)
- case ('l0')
- constitutive_dislotwin_L0(i) = IO_floatValue(line,positions,2_pInt)
- case ('xc')
- constitutive_dislotwin_xc(i) = IO_floatValue(line,positions,2_pInt)
- case ('vcrossslip')
- constitutive_dislotwin_VcrossSlip(i) = IO_floatValue(line,positions,2_pInt)
- case ('cedgedipmindistance')
- constitutive_dislotwin_CEdgeDipMinDistance(i) = IO_floatValue(line,positions,2_pInt)
- case ('catomicvolume')
- constitutive_dislotwin_CAtomicVolume(i) = IO_floatValue(line,positions,2_pInt)
- case ('interaction_slipslip','interactionslipslip')
- if (positions(1) < 1_pInt + Nchunks_SlipSlip) then
- call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
- endif
- do j = 1_pInt, Nchunks_SlipSlip
- constitutive_dislotwin_interaction_SlipSlip(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('interaction_sliptwin','interactionsliptwin')
- if (positions(1) < 1_pInt + Nchunks_SlipTwin) then
- call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
- endif
- do j = 1_pInt, Nchunks_SlipTwin
- constitutive_dislotwin_interaction_SlipTwin(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('interaction_twinslip','interactiontwinslip')
- if (positions(1) < 1_pInt + Nchunks_TwinSlip) then
- call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
- endif
- do j = 1_pInt, Nchunks_TwinSlip
- constitutive_dislotwin_interaction_TwinSlip(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('interaction_twintwin','interactiontwintwin')
- if (positions(1) < 1_pInt + Nchunks_TwinTwin) then
- call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
- endif
- do j = 1_pInt, Nchunks_TwinTwin
- constitutive_dislotwin_interaction_TwinTwin(j,i) = IO_floatValue(line,positions,1_pInt+j)
- enddo
- case ('sfe_0k')
- constitutive_dislotwin_SFE_0K(i) = IO_floatValue(line,positions,2_pInt)
- case ('dsfe_dt')
- constitutive_dislotwin_dSFE_dT(i) = IO_floatValue(line,positions,2_pInt)
- case ('shearbandresistance')
- constitutive_dislotwin_sbResistance(i) = IO_floatValue(line,positions,2_pInt)
- case ('shearbandvelocity')
- constitutive_dislotwin_sbVelocity(i) = IO_floatValue(line,positions,2_pInt)
- case ('qedgepersbsystem')
- constitutive_dislotwin_sbQedge(i) = IO_floatValue(line,positions,2_pInt)
- case default
+ i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase
+ positions = IO_stringPos(line,maxNchunks)
+ tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
+ select case(tag)
+ case ('plasticity', 'elasticity')
+ cycle
+ case ('(output)')
+ constitutive_dislotwin_Noutput(i) = constitutive_dislotwin_Noutput(i) + 1_pInt
+ constitutive_dislotwin_output(constitutive_dislotwin_Noutput(i),i) = IO_lc(IO_stringValue(line,positions,2_pInt))
+ case ('lattice_structure')
+ constitutive_dislotwin_structureName(i) = IO_lc(IO_stringValue(line,positions,2_pInt))
+ configNchunks = lattice_configNchunks(constitutive_dislotwin_structureName(i))
+ Nchunks_SlipFamilies = configNchunks(1)
+ Nchunks_TwinFamilies = configNchunks(2)
+ Nchunks_SlipSlip = configNchunks(3)
+ Nchunks_SlipTwin = configNchunks(4)
+ Nchunks_TwinSlip = configNchunks(5)
+ Nchunks_TwinTwin = configNchunks(6)
+ case ('covera_ratio')
+ constitutive_dislotwin_CoverA(i) = IO_floatValue(line,positions,2_pInt)
+ case ('c11')
+ constitutive_dislotwin_Cslip_66(1,1,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c12')
+ constitutive_dislotwin_Cslip_66(1,2,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c13')
+ constitutive_dislotwin_Cslip_66(1,3,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c22')
+ constitutive_dislotwin_Cslip_66(2,2,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c23')
+ constitutive_dislotwin_Cslip_66(2,3,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c33')
+ constitutive_dislotwin_Cslip_66(3,3,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c44')
+ constitutive_dislotwin_Cslip_66(4,4,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c55')
+ constitutive_dislotwin_Cslip_66(5,5,i) = IO_floatValue(line,positions,2_pInt)
+ case ('c66')
+ constitutive_dislotwin_Cslip_66(6,6,i) = IO_floatValue(line,positions,2_pInt)
+ case ('nslip')
+ if (positions(1) < 1_pInt + Nchunks_SlipFamilies) then
+ call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
+ endif
+ Nchunks_SlipFamilies = positions(1) - 1_pInt
+ do j = 1_pInt, Nchunks_SlipFamilies
+ constitutive_dislotwin_Nslip(j,i) = IO_intValue(line,positions,1_pInt+j)
+ enddo
+ case ('ntwin')
+ if (positions(1) < 1_pInt + Nchunks_TwinFamilies) then
+ call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
+ endif
+ Nchunks_TwinFamilies = positions(1) - 1_pInt
+ do j = 1_pInt, Nchunks_TwinFamilies
+ constitutive_dislotwin_Ntwin(j,i) = IO_intValue(line,positions,1_pInt+j)
+ enddo
+ case ('rhoedge0')
+ do j = 1_pInt, Nchunks_SlipFamilies
+ constitutive_dislotwin_rhoEdge0(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('rhoedgedip0')
+ do j = 1_pInt, Nchunks_SlipFamilies
+ constitutive_dislotwin_rhoEdgeDip0(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('slipburgers')
+ do j = 1_pInt, Nchunks_SlipFamilies
+ constitutive_dislotwin_burgersPerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('twinburgers')
+ do j = 1_pInt, Nchunks_TwinFamilies
+ constitutive_dislotwin_burgersPerTwinFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('qedge')
+ do j = 1_pInt, Nchunks_SlipFamilies
+ constitutive_dislotwin_QedgePerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('v0')
+ do j = 1_pInt, Nchunks_SlipFamilies
+ constitutive_dislotwin_v0PerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('ndot0')
+ do j = 1_pInt, Nchunks_TwinFamilies
+ constitutive_dislotwin_Ndot0PerTwinFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('twinsize')
+ do j = 1_pInt, Nchunks_TwinFamilies
+ constitutive_dislotwin_twinsizePerTwinFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('clambdaslip')
+ do j = 1_pInt, Nchunks_SlipFamilies
+ constitutive_dislotwin_CLambdaSlipPerSlipFamily(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('grainsize')
+ constitutive_dislotwin_GrainSize(i) = IO_floatValue(line,positions,2_pInt)
+ case ('maxtwinfraction')
+ constitutive_dislotwin_MaxTwinFraction(i) = IO_floatValue(line,positions,2_pInt)
+ case ('pexponent')
+ constitutive_dislotwin_p(i) = IO_floatValue(line,positions,2_pInt)
+ case ('qexponent')
+ constitutive_dislotwin_q(i) = IO_floatValue(line,positions,2_pInt)
+ case ('rexponent')
+ constitutive_dislotwin_r(i) = IO_floatValue(line,positions,2_pInt)
+ case ('d0')
+ constitutive_dislotwin_D0(i) = IO_floatValue(line,positions,2_pInt)
+ case ('qsd')
+ constitutive_dislotwin_Qsd(i) = IO_floatValue(line,positions,2_pInt)
+ case ('atol_rho')
+ constitutive_dislotwin_aTolRho(i) = IO_floatValue(line,positions,2_pInt)
+ case ('atol_twinfrac')
+ constitutive_dislotwin_aTolTwinFrac(i) = IO_floatValue(line,positions,2_pInt)
+ case ('cmfptwin')
+ constitutive_dislotwin_Cmfptwin(i) = IO_floatValue(line,positions,2_pInt)
+ case ('cthresholdtwin')
+ constitutive_dislotwin_Cthresholdtwin(i) = IO_floatValue(line,positions,2_pInt)
+ case ('solidsolutionstrength')
+ constitutive_dislotwin_SolidSolutionStrength(i) = IO_floatValue(line,positions,2_pInt)
+ case ('l0')
+ constitutive_dislotwin_L0(i) = IO_floatValue(line,positions,2_pInt)
+ case ('xc')
+ constitutive_dislotwin_xc(i) = IO_floatValue(line,positions,2_pInt)
+ case ('vcrossslip')
+ constitutive_dislotwin_VcrossSlip(i) = IO_floatValue(line,positions,2_pInt)
+ case ('cedgedipmindistance')
+ constitutive_dislotwin_CEdgeDipMinDistance(i) = IO_floatValue(line,positions,2_pInt)
+ case ('catomicvolume')
+ constitutive_dislotwin_CAtomicVolume(i) = IO_floatValue(line,positions,2_pInt)
+ case ('interaction_slipslip','interactionslipslip')
+ if (positions(1) < 1_pInt + Nchunks_SlipSlip) then
+ call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
+ endif
+ do j = 1_pInt, Nchunks_SlipSlip
+ constitutive_dislotwin_interaction_SlipSlip(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('interaction_sliptwin','interactionsliptwin')
+ if (positions(1) < 1_pInt + Nchunks_SlipTwin) then
+ call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
+ endif
+ do j = 1_pInt, Nchunks_SlipTwin
+ constitutive_dislotwin_interaction_SlipTwin(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('interaction_twinslip','interactiontwinslip')
+ if (positions(1) < 1_pInt + Nchunks_TwinSlip) then
+ call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
+ endif
+ do j = 1_pInt, Nchunks_TwinSlip
+ constitutive_dislotwin_interaction_TwinSlip(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('interaction_twintwin','interactiontwintwin')
+ if (positions(1) < 1_pInt + Nchunks_TwinTwin) then
+ call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')')
+ endif
+ do j = 1_pInt, Nchunks_TwinTwin
+ constitutive_dislotwin_interaction_TwinTwin(j,i) = IO_floatValue(line,positions,1_pInt+j)
+ enddo
+ case ('sfe_0k')
+ constitutive_dislotwin_SFE_0K(i) = IO_floatValue(line,positions,2_pInt)
+ case ('dsfe_dt')
+ constitutive_dislotwin_dSFE_dT(i) = IO_floatValue(line,positions,2_pInt)
+ case ('shearbandresistance')
+ constitutive_dislotwin_sbResistance(i) = IO_floatValue(line,positions,2_pInt)
+ case ('shearbandvelocity')
+ constitutive_dislotwin_sbVelocity(i) = IO_floatValue(line,positions,2_pInt)
+ case ('qedgepersbsystem')
+ constitutive_dislotwin_sbQedge(i) = IO_floatValue(line,positions,2_pInt)
+ case default
call IO_error(210_pInt,ext_msg=trim(tag)//' ('//constitutive_dislotwin_label//')')
- end select
- endif
- endif
-enddo
-
- do i = 1_pInt,maxNinstance
- constitutive_dislotwin_structure(i) = &
- lattice_initializeStructure(constitutive_dislotwin_structureName(i),constitutive_dislotwin_CoverA(i))
- myStructure = constitutive_dislotwin_structure(i)
-
- !* Sanity checks
- if (myStructure < 1_pInt) call IO_error(205_pInt,el=i)
- if (sum(constitutive_dislotwin_Nslip(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='Nslip (' &
- //constitutive_dislotwin_label//')')
- if (sum(constitutive_dislotwin_Ntwin(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='Ntwin (' &
- //constitutive_dislotwin_label//')')
- do f = 1_pInt,lattice_maxNslipFamily
- if (constitutive_dislotwin_Nslip(f,i) > 0_pInt) then
- if (constitutive_dislotwin_rhoEdge0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rhoEdge0 (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_rhoEdgeDip0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rhoEdgeDip0 (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_burgersPerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='slipBurgers (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_v0PerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='v0 (' &
- //constitutive_dislotwin_label//')')
+ end select
endif
- enddo
- do f = 1_pInt,lattice_maxNtwinFamily
- if (constitutive_dislotwin_Ntwin(f,i) > 0_pInt) then
- if (constitutive_dislotwin_burgersPerTwinFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='twinburgers (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_Ndot0PerTwinFamily(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='ndot0 (' &
- //constitutive_dislotwin_label//')')
- endif
- enddo
- if (constitutive_dislotwin_CAtomicVolume(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='cAtomicVolume (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_D0(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='D0 (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_Qsd(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='Qsd (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_SFE_0K(i) == 0.0_pReal .and. &
- constitutive_dislotwin_dSFE_dT(i) == 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='SFE (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_aTolRho(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolRho (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_aTolTwinFrac(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolTwinFrac (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_sbResistance(i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='sbResistance (' &
- //constitutive_dislotwin_label//')')
- if (constitutive_dislotwin_sbVelocity(i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='sbVelocity (' &
- //constitutive_dislotwin_label//')')
-
- !* Determine total number of active slip or twin systems
- constitutive_dislotwin_Nslip(:,i) = min(lattice_NslipSystem(:,myStructure),constitutive_dislotwin_Nslip(:,i))
- constitutive_dislotwin_Ntwin(:,i) = min(lattice_NtwinSystem(:,myStructure),constitutive_dislotwin_Ntwin(:,i))
- constitutive_dislotwin_totalNslip(i) = sum(constitutive_dislotwin_Nslip(:,i))
- constitutive_dislotwin_totalNtwin(i) = sum(constitutive_dislotwin_Ntwin(:,i))
-
-enddo
-
-!* Allocation of variables whose size depends on the total number of active slip systems
-maxTotalNslip = maxval(constitutive_dislotwin_totalNslip)
-maxTotalNtwin = maxval(constitutive_dislotwin_totalNtwin)
-
-!write(6,*) 'nslip',i,constitutive_dislotwin_totalNslip(i),maxTotalNslip
-!write(6,*) 'ntwin',i,constitutive_dislotwin_totalNtwin(i),maxTotalNtwin
-
-allocate(constitutive_dislotwin_burgersPerSlipSystem(maxTotalNslip, maxNinstance))
- constitutive_dislotwin_burgersPerSlipSystem = 0.0_pReal
-allocate(constitutive_dislotwin_burgersPerTwinSystem(maxTotalNtwin, maxNinstance))
- constitutive_dislotwin_burgersPerTwinSystem= 0.0_pReal
-allocate(constitutive_dislotwin_QedgePerSlipSystem(maxTotalNslip, maxNinstance))
- constitutive_dislotwin_QedgePerSlipSystem = 0.0_pReal
-allocate(constitutive_dislotwin_v0PerSlipSystem(maxTotalNslip, maxNinstance))
- constitutive_dislotwin_v0PerSlipSystem = 0.0_pReal
-allocate(constitutive_dislotwin_Ndot0PerTwinSystem(maxTotalNtwin, maxNinstance))
- constitutive_dislotwin_Ndot0PerTwinSystem = 0.0_pReal
-allocate(constitutive_dislotwin_tau_r(maxTotalNtwin, maxNinstance))
- constitutive_dislotwin_tau_r = 0.0_pReal
-allocate(constitutive_dislotwin_twinsizePerTwinSystem(maxTotalNtwin, maxNinstance))
- constitutive_dislotwin_twinsizePerTwinSystem = 0.0_pReal
-allocate(constitutive_dislotwin_CLambdaSlipPerSlipSystem(maxTotalNslip, maxNinstance))
- constitutive_dislotwin_CLambdaSlipPerSlipSystem = 0.0_pReal
-
-allocate(constitutive_dislotwin_interactionMatrix_SlipSlip(maxTotalNslip,maxTotalNslip,maxNinstance))
- constitutive_dislotwin_interactionMatrix_SlipSlip = 0.0_pReal
-allocate(constitutive_dislotwin_interactionMatrix_SlipTwin(maxTotalNslip,maxTotalNtwin,maxNinstance))
- constitutive_dislotwin_interactionMatrix_SlipTwin = 0.0_pReal
-allocate(constitutive_dislotwin_interactionMatrix_TwinSlip(maxTotalNtwin,maxTotalNslip,maxNinstance))
- constitutive_dislotwin_interactionMatrix_TwinSlip = 0.0_pReal
-allocate(constitutive_dislotwin_interactionMatrix_TwinTwin(maxTotalNtwin,maxTotalNtwin,maxNinstance))
- constitutive_dislotwin_interactionMatrix_TwinTwin = 0.0_pReal
-allocate(constitutive_dislotwin_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance))
- constitutive_dislotwin_forestProjectionEdge = 0.0_pReal
-
-allocate(constitutive_dislotwin_Ctwin_66(6,6,maxTotalNtwin,maxNinstance))
- constitutive_dislotwin_Ctwin_66 = 0.0_pReal
-allocate(constitutive_dislotwin_Ctwin_3333(3,3,3,3,maxTotalNtwin,maxNinstance))
- constitutive_dislotwin_Ctwin_3333 = 0.0_pReal
-
-do i = 1_pInt,maxNinstance
- myStructure = constitutive_dislotwin_structure(i)
-
- ns = constitutive_dislotwin_totalNslip(i)
- nt = constitutive_dislotwin_totalNtwin(i)
- ! write(6,*) 'instance',i,'has nslip and ntwin',ns,nt
-
- !* Determine size of state array
-
- constitutive_dislotwin_sizeDotState(i) = int(size(constitutive_dislotwin_listBasicSlipStates),pInt) * ns &
- + int(size(constitutive_dislotwin_listBasicTwinStates),pInt) * nt
- constitutive_dislotwin_sizeState(i) = constitutive_dislotwin_sizeDotState(i) &
- + int(size(constitutive_dislotwin_listDependentSlipStates),pInt) * ns &
- + int(size(constitutive_dislotwin_listDependentTwinStates),pInt) * nt
-
- !* Determine size of postResults array
- do o = 1_pInt,constitutive_dislotwin_Noutput(i)
- select case(constitutive_dislotwin_output(o,i))
- case('edge_density', &
- 'dipole_density', &
- 'shear_rate_slip', &
- 'accumulated_shear_slip', &
- 'mfp_slip', &
- 'resolved_stress_slip', &
- 'threshold_stress_slip', &
- 'edge_dipole_distance', &
- 'stress_exponent' &
- )
- mySize = ns
- case('twin_fraction', &
- 'shear_rate_twin', &
- 'accumulated_shear_twin', &
- 'mfp_twin', &
- 'resolved_stress_twin', &
- 'threshold_stress_twin' &
- )
- mySize = nt
- case('resolved_stress_shearband', &
- 'shear_rate_shearband' &
- )
- mySize = 6_pInt
- case('sb_eigenvalues')
- mySize = 3_pInt
- case('sb_eigenvectors')
- mySize = 9_pInt
- case default
- call IO_error(212_pInt,ext_msg=constitutive_dislotwin_output(o,i)//' ('//constitutive_dislotwin_label//')')
- end select
-
- if (mySize > 0_pInt) then ! any meaningful output found
- constitutive_dislotwin_sizePostResult(o,i) = mySize
- constitutive_dislotwin_sizePostResults(i) = constitutive_dislotwin_sizePostResults(i) + mySize
- endif
- enddo
-
+ endif
+ enddo
+
+ sanityChecks: do i = 1_pInt,maxNinstance
+ constitutive_dislotwin_structure(i) = &
+ lattice_initializeStructure(constitutive_dislotwin_structureName(i),constitutive_dislotwin_CoverA(i))
+ structID = constitutive_dislotwin_structure(i)
+
+ if (structID < 1_pInt) call IO_error(205_pInt,el=i)
+ if (sum(constitutive_dislotwin_Nslip(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='Nslip (' &
+ //constitutive_dislotwin_label//')')
+ if (sum(constitutive_dislotwin_Ntwin(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='Ntwin (' &
+ //constitutive_dislotwin_label//')')
+ do f = 1_pInt,lattice_maxNslipFamily
+ if (constitutive_dislotwin_Nslip(f,i) > 0_pInt) then
+ if (constitutive_dislotwin_rhoEdge0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rhoEdge0 (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_rhoEdgeDip0(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='rhoEdgeDip0 (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_burgersPerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='slipBurgers (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_v0PerSlipFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='v0 (' &
+ //constitutive_dislotwin_label//')')
+ endif
+ enddo
+ do f = 1_pInt,lattice_maxNtwinFamily
+ if (constitutive_dislotwin_Ntwin(f,i) > 0_pInt) then
+ if (constitutive_dislotwin_burgersPerTwinFamily(f,i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='twinburgers (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_Ndot0PerTwinFamily(f,i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='ndot0 (' &
+ //constitutive_dislotwin_label//')')
+ endif
+ enddo
+ if (constitutive_dislotwin_CAtomicVolume(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='cAtomicVolume (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_D0(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='D0 (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_Qsd(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='Qsd (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_SFE_0K(i) == 0.0_pReal .and. &
+ constitutive_dislotwin_dSFE_dT(i) == 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='SFE (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_aTolRho(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolRho (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_aTolTwinFrac(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolTwinFrac (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_sbResistance(i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='sbResistance (' &
+ //constitutive_dislotwin_label//')')
+ if (constitutive_dislotwin_sbVelocity(i) < 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='sbVelocity (' &
+ //constitutive_dislotwin_label//')')
+
+ !* Determine total number of active slip or twin systems
+ constitutive_dislotwin_Nslip(:,i) = min(lattice_NslipSystem(:,structID),constitutive_dislotwin_Nslip(:,i))
+ constitutive_dislotwin_Ntwin(:,i) = min(lattice_NtwinSystem(:,structID),constitutive_dislotwin_Ntwin(:,i))
+ constitutive_dislotwin_totalNslip(i) = sum(constitutive_dislotwin_Nslip(:,i))
+ constitutive_dislotwin_totalNtwin(i) = sum(constitutive_dislotwin_Ntwin(:,i))
+ enddo sanityChecks
+
+!--------------------------------------------------------------------------------------------------
+! allocation of variables whose size depends on the total number of active slip systems
+ maxTotalNslip = maxval(constitutive_dislotwin_totalNslip)
+ maxTotalNtwin = maxval(constitutive_dislotwin_totalNtwin)
+
+ !write(6,*) 'nslip',i,constitutive_dislotwin_totalNslip(i),maxTotalNslip
+ !write(6,*) 'ntwin',i,constitutive_dislotwin_totalNtwin(i),maxTotalNtwin
+
+ allocate(constitutive_dislotwin_burgersPerSlipSystem(maxTotalNslip, maxNinstance))
+ constitutive_dislotwin_burgersPerSlipSystem = 0.0_pReal
+ allocate(constitutive_dislotwin_burgersPerTwinSystem(maxTotalNtwin, maxNinstance))
+ constitutive_dislotwin_burgersPerTwinSystem= 0.0_pReal
+ allocate(constitutive_dislotwin_QedgePerSlipSystem(maxTotalNslip, maxNinstance))
+ constitutive_dislotwin_QedgePerSlipSystem = 0.0_pReal
+ allocate(constitutive_dislotwin_v0PerSlipSystem(maxTotalNslip, maxNinstance))
+ constitutive_dislotwin_v0PerSlipSystem = 0.0_pReal
+ allocate(constitutive_dislotwin_Ndot0PerTwinSystem(maxTotalNtwin, maxNinstance))
+ constitutive_dislotwin_Ndot0PerTwinSystem = 0.0_pReal
+ allocate(constitutive_dislotwin_tau_r(maxTotalNtwin, maxNinstance))
+ constitutive_dislotwin_tau_r = 0.0_pReal
+ allocate(constitutive_dislotwin_twinsizePerTwinSystem(maxTotalNtwin, maxNinstance))
+ constitutive_dislotwin_twinsizePerTwinSystem = 0.0_pReal
+ allocate(constitutive_dislotwin_CLambdaSlipPerSlipSystem(maxTotalNslip, maxNinstance))
+ constitutive_dislotwin_CLambdaSlipPerSlipSystem = 0.0_pReal
+
+ allocate(constitutive_dislotwin_interactionMatrix_SlipSlip(maxTotalNslip,maxTotalNslip,maxNinstance))
+ constitutive_dislotwin_interactionMatrix_SlipSlip = 0.0_pReal
+ allocate(constitutive_dislotwin_interactionMatrix_SlipTwin(maxTotalNslip,maxTotalNtwin,maxNinstance))
+ constitutive_dislotwin_interactionMatrix_SlipTwin = 0.0_pReal
+ allocate(constitutive_dislotwin_interactionMatrix_TwinSlip(maxTotalNtwin,maxTotalNslip,maxNinstance))
+ constitutive_dislotwin_interactionMatrix_TwinSlip = 0.0_pReal
+ allocate(constitutive_dislotwin_interactionMatrix_TwinTwin(maxTotalNtwin,maxTotalNtwin,maxNinstance))
+ constitutive_dislotwin_interactionMatrix_TwinTwin = 0.0_pReal
+ allocate(constitutive_dislotwin_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance))
+ constitutive_dislotwin_forestProjectionEdge = 0.0_pReal
+
+ allocate(constitutive_dislotwin_Ctwin_66(6,6,maxTotalNtwin,maxNinstance))
+ constitutive_dislotwin_Ctwin_66 = 0.0_pReal
+ allocate(constitutive_dislotwin_Ctwin_3333(3,3,3,3,maxTotalNtwin,maxNinstance))
+ constitutive_dislotwin_Ctwin_3333 = 0.0_pReal
+
+ instancesLoop: do i = 1_pInt,maxNinstance
+ structID = constitutive_dislotwin_structure(i)
+
+ ns = constitutive_dislotwin_totalNslip(i)
+ nt = constitutive_dislotwin_totalNtwin(i)
+ ! write(6,*) 'instance',i,'has nslip and ntwin',ns,nt
+
+ !* Determine size of state array
+ constitutive_dislotwin_sizeDotState(i) = int(size(CONSTITUTIVE_DISLOTWIN_listBasicSlipStates),pInt) * ns &
+ + int(size(CONSTITUTIVE_DISLOTWIN_listBasicTwinStates),pInt) * nt
+ constitutive_dislotwin_sizeState(i) = constitutive_dislotwin_sizeDotState(i) &
+ + 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(i)
+ select case(constitutive_dislotwin_output(o,i))
+ case('edge_density', &
+ 'dipole_density', &
+ 'shear_rate_slip', &
+ 'accumulated_shear_slip', &
+ 'mfp_slip', &
+ 'resolved_stress_slip', &
+ 'threshold_stress_slip', &
+ 'edge_dipole_distance', &
+ 'stress_exponent' &
+ )
+ mySize = ns
+ case('twin_fraction', &
+ 'shear_rate_twin', &
+ 'accumulated_shear_twin', &
+ 'mfp_twin', &
+ 'resolved_stress_twin', &
+ 'threshold_stress_twin' &
+ )
+ mySize = nt
+ case('resolved_stress_shearband', &
+ 'shear_rate_shearband' &
+ )
+ mySize = 6_pInt
+ case('sb_eigenvalues')
+ mySize = 3_pInt
+ case('sb_eigenvectors')
+ mySize = 9_pInt
+ case default
+ call IO_error(212_pInt,ext_msg=constitutive_dislotwin_output(o,i)//' ('//constitutive_dislotwin_label//')')
+ end select
+
+ if (mySize > 0_pInt) then ! any meaningful output found
+ constitutive_dislotwin_sizePostResult(o,i) = mySize
+ constitutive_dislotwin_sizePostResults(i) = constitutive_dislotwin_sizePostResults(i) + mySize
+ endif
+ enddo outputsLoop
+
+
+ !* Elasticity matrix and shear modulus according to material.config
+ constitutive_dislotwin_Cslip_66(1:6,1:6,i) = lattice_symmetrizeC66(constitutive_dislotwin_structureName(i),&
+ constitutive_dislotwin_Cslip_66(:,:,i))
+ constitutive_dislotwin_Gmod(i) = &
+ 0.2_pReal*(constitutive_dislotwin_Cslip_66(1,1,i)-constitutive_dislotwin_Cslip_66(1,2,i)) &
+ +0.6_pReal*constitutive_dislotwin_Cslip_66(4,4,i) ! (C11iso-C12iso)/2 with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5
+ constitutive_dislotwin_nu(i) = ( constitutive_dislotwin_Cslip_66(1,1,i) + 4.0_pReal*constitutive_dislotwin_Cslip_66(1,2,i) &
+ - 2.0_pReal*constitutive_dislotwin_Cslip_66(1,2,i) ) &
+ / ( 4.0_pReal*constitutive_dislotwin_Cslip_66(1,1,i) + 6.0_pReal*constitutive_dislotwin_Cslip_66(1,2,i) &
+ + 2.0_pReal*constitutive_dislotwin_Cslip_66(4,4,i) )
+ constitutive_dislotwin_Cslip_66(1:6,1:6,i) = &
+ math_Mandel3333to66(math_Voigt66to3333(constitutive_dislotwin_Cslip_66(1:6,1:6,i)))
+ constitutive_dislotwin_Cslip_3333(1:3,1:3,1:3,1:3,i) = &
+ math_Voigt66to3333(constitutive_dislotwin_Cslip_66(1:6,1:6,i))
+
+
+ !* Process slip related parameters ------------------------------------------------
+
+ do f = 1_pInt,lattice_maxNslipFamily
+ index_myFamily = sum(constitutive_dislotwin_Nslip(1:f-1_pInt,i)) ! index in truncated slip system list
+
+ do j = 1_pInt,constitutive_dislotwin_Nslip(f,i) ! system in family
+
+ !* Burgers vector,
+ ! dislocation velocity prefactor,
+ ! mean free path prefactor,
+ ! and minimum dipole distance
+
+ constitutive_dislotwin_burgersPerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_burgersPerSlipFamily(f,i)
+ constitutive_dislotwin_QedgePerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_QedgePerSlipFamily(f,i)
+ constitutive_dislotwin_v0PerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_v0PerSlipFamily(f,i)
+ constitutive_dislotwin_CLambdaSlipPerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_CLambdaSlipPerSlipFamily(f,i)
+
+ !* Calculation of forest projections for edge dislocations
+ !* Interaction matrices
+
+ do o = 1_pInt,lattice_maxNslipFamily
+ index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,i))
+ do k = 1_pInt,constitutive_dislotwin_Nslip(o,i) ! loop over (active) systems in other family (slip)
+ constitutive_dislotwin_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,i) = &
+ abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,structID))+j,structID), &
+ lattice_st(:,sum(lattice_NslipSystem(1:o-1,structID))+k,structID)))
+ constitutive_dislotwin_interactionMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,i) = &
+ constitutive_dislotwin_interaction_SlipSlip(lattice_interactionSlipSlip( &
+ sum(lattice_NslipSystem(1:f-1,structID))+j, &
+ sum(lattice_NslipSystem(1:o-1,structID))+k, &
+ structID), i )
+ enddo; enddo
+
+ do o = 1_pInt,lattice_maxNtwinFamily
+ index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,i))
+ do k = 1_pInt,constitutive_dislotwin_Ntwin(o,i) ! loop over (active) systems in other family (twin)
+ constitutive_dislotwin_interactionMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,i) = &
+ constitutive_dislotwin_interaction_SlipTwin(lattice_interactionSlipTwin( &
+ sum(lattice_NslipSystem(1:f-1_pInt,structID))+j, &
+ sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, &
+ structID), i )
+ enddo; enddo
+
+ enddo ! slip system in family
+ enddo ! slip families
+
+ !* Process twin related parameters ------------------------------------------------
- !* Elasticity matrix and shear modulus according to material.config
- constitutive_dislotwin_Cslip_66(1:6,1:6,i) = lattice_symmetrizeC66(constitutive_dislotwin_structureName(i),&
- constitutive_dislotwin_Cslip_66(:,:,i))
- constitutive_dislotwin_Gmod(i) = &
- 0.2_pReal*(constitutive_dislotwin_Cslip_66(1,1,i)-constitutive_dislotwin_Cslip_66(1,2,i)) &
- +0.6_pReal*constitutive_dislotwin_Cslip_66(4,4,i) ! (C11iso-C12iso)/2 with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5
- constitutive_dislotwin_nu(i) = ( constitutive_dislotwin_Cslip_66(1,1,i) + 4.0_pReal*constitutive_dislotwin_Cslip_66(1,2,i) &
- - 2.0_pReal*constitutive_dislotwin_Cslip_66(1,2,i) ) &
- / ( 4.0_pReal*constitutive_dislotwin_Cslip_66(1,1,i) + 6.0_pReal*constitutive_dislotwin_Cslip_66(1,2,i) &
- + 2.0_pReal*constitutive_dislotwin_Cslip_66(4,4,i) )
- constitutive_dislotwin_Cslip_66(1:6,1:6,i) = &
- math_Mandel3333to66(math_Voigt66to3333(constitutive_dislotwin_Cslip_66(1:6,1:6,i)))
- constitutive_dislotwin_Cslip_3333(1:3,1:3,1:3,1:3,i) = &
- math_Voigt66to3333(constitutive_dislotwin_Cslip_66(1:6,1:6,i))
-
-
- !* Process slip related parameters ------------------------------------------------
-
- do f = 1_pInt,lattice_maxNslipFamily
- index_myFamily = sum(constitutive_dislotwin_Nslip(1:f-1_pInt,i)) ! index in truncated slip system list
-
- do j = 1_pInt,constitutive_dislotwin_Nslip(f,i) ! system in family
-
- !* Burgers vector,
- ! dislocation velocity prefactor,
- ! mean free path prefactor,
- ! and minimum dipole distance
-
- constitutive_dislotwin_burgersPerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_burgersPerSlipFamily(f,i)
- constitutive_dislotwin_QedgePerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_QedgePerSlipFamily(f,i)
- constitutive_dislotwin_v0PerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_v0PerSlipFamily(f,i)
- constitutive_dislotwin_CLambdaSlipPerSlipSystem(index_myFamily+j,i) = constitutive_dislotwin_CLambdaSlipPerSlipFamily(f,i)
-
- !* Calculation of forest projections for edge dislocations
+ do f = 1_pInt,lattice_maxNtwinFamily
+ index_myFamily = sum(constitutive_dislotwin_Ntwin(1:f-1_pInt,i)) ! index in truncated twin system list
+
+ do j = 1_pInt,constitutive_dislotwin_Ntwin(f,i) ! system in family
+
+ !* Burgers vector,
+ ! nucleation rate prefactor,
+ ! and twin size
+
+ constitutive_dislotwin_burgersPerTwinSystem(index_myFamily+j,i) = constitutive_dislotwin_burgersPerTwinFamily(f,i)
+ constitutive_dislotwin_Ndot0PerTwinSystem(index_myFamily+j,i) = constitutive_dislotwin_Ndot0PerTwinFamily(f,i)
+ constitutive_dislotwin_twinsizePerTwinSystem(index_myFamily+j,i) = constitutive_dislotwin_twinsizePerTwinFamily(f,i)
+
+ !* Rotate twin elasticity matrices
+
+ index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! index in full lattice twin list
+ do l = 1_pInt,3_pInt ; do m = 1_pInt,3_pInt ; do n = 1_pInt,3_pInt ; do o = 1_pInt,3_pInt
+ do p = 1_pInt,3_pInt ; do q = 1_pInt,3_pInt ; do r = 1_pInt,3_pInt ; do s = 1_pInt,3_pInt
+ constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,i) = &
+ constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,i) + &
+ constitutive_dislotwin_Cslip_3333(p,q,r,s,i) * &
+ lattice_Qtwin(l,p,index_otherFamily+j,structID) * &
+ lattice_Qtwin(m,q,index_otherFamily+j,structID) * &
+ lattice_Qtwin(n,r,index_otherFamily+j,structID) * &
+ lattice_Qtwin(o,s,index_otherFamily+j,structID)
+ enddo ; enddo ; enddo ; enddo
+ enddo ; enddo ; enddo ; enddo
+ constitutive_dislotwin_Ctwin_66(1:6,1:6,index_myFamily+j,i) = &
+ math_Mandel3333to66(constitutive_dislotwin_Ctwin_3333(1:3,1:3,1:3,1:3,index_myFamily+j,i))
+
!* Interaction matrices
-
- do o = 1_pInt,lattice_maxNslipFamily
- index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,i))
- do k = 1_pInt,constitutive_dislotwin_Nslip(o,i) ! loop over (active) systems in other family (slip)
- constitutive_dislotwin_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,i) = &
- abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,myStructure))+j,myStructure), &
- lattice_st(:,sum(lattice_NslipSystem(1:o-1,myStructure))+k,myStructure)))
- constitutive_dislotwin_interactionMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,i) = &
- constitutive_dislotwin_interaction_SlipSlip(lattice_interactionSlipSlip( &
- sum(lattice_NslipSystem(1:f-1,myStructure))+j, &
- sum(lattice_NslipSystem(1:o-1,myStructure))+k, &
- myStructure), i )
- enddo; enddo
-
- do o = 1_pInt,lattice_maxNtwinFamily
- index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,i))
- do k = 1_pInt,constitutive_dislotwin_Ntwin(o,i) ! loop over (active) systems in other family (twin)
- constitutive_dislotwin_interactionMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,i) = &
- constitutive_dislotwin_interaction_SlipTwin(lattice_interactionSlipTwin( &
- sum(lattice_NslipSystem(1:f-1_pInt,myStructure))+j, &
- sum(lattice_NtwinSystem(1:o-1_pInt,myStructure))+k, &
- myStructure), i )
- enddo; enddo
-
- enddo ! slip system in family
- enddo ! slip families
-
- !* Process twin related parameters ------------------------------------------------
-
- do f = 1_pInt,lattice_maxNtwinFamily
- index_myFamily = sum(constitutive_dislotwin_Ntwin(1:f-1_pInt,i)) ! index in truncated twin system list
-
- do j = 1_pInt,constitutive_dislotwin_Ntwin(f,i) ! system in family
-
- !* Burgers vector,
- ! nucleation rate prefactor,
- ! and twin size
-
- constitutive_dislotwin_burgersPerTwinSystem(index_myFamily+j,i) = constitutive_dislotwin_burgersPerTwinFamily(f,i)
- constitutive_dislotwin_Ndot0PerTwinSystem(index_myFamily+j,i) = constitutive_dislotwin_Ndot0PerTwinFamily(f,i)
- constitutive_dislotwin_twinsizePerTwinSystem(index_myFamily+j,i) = constitutive_dislotwin_twinsizePerTwinFamily(f,i)
-
- !* Rotate twin elasticity matrices
-
- index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,myStructure)) ! index in full lattice twin list
- do l = 1_pInt,3_pInt ; do m = 1_pInt,3_pInt ; do n = 1_pInt,3_pInt ; do o = 1_pInt,3_pInt
- do p = 1_pInt,3_pInt ; do q = 1_pInt,3_pInt ; do r = 1_pInt,3_pInt ; do s = 1_pInt,3_pInt
- constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,i) = &
- constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,i) + &
- constitutive_dislotwin_Cslip_3333(p,q,r,s,i) * &
- lattice_Qtwin(l,p,index_otherFamily+j,myStructure) * &
- lattice_Qtwin(m,q,index_otherFamily+j,myStructure) * &
- lattice_Qtwin(n,r,index_otherFamily+j,myStructure) * &
- lattice_Qtwin(o,s,index_otherFamily+j,myStructure)
- enddo ; enddo ; enddo ; enddo
- enddo ; enddo ; enddo ; enddo
- constitutive_dislotwin_Ctwin_66(1:6,1:6,index_myFamily+j,i) = &
- math_Mandel3333to66(constitutive_dislotwin_Ctwin_3333(1:3,1:3,1:3,1:3,index_myFamily+j,i))
-
- !* Interaction matrices
-
- do o = 1_pInt,lattice_maxNslipFamily
- index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,i))
- do k = 1_pInt,constitutive_dislotwin_Nslip(o,i) ! loop over (active) systems in other family (slip)
- constitutive_dislotwin_interactionMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,i) = &
- constitutive_dislotwin_interaction_TwinSlip(lattice_interactionTwinSlip( &
- sum(lattice_NtwinSystem(1:f-1_pInt,myStructure))+j, &
- sum(lattice_NslipSystem(1:o-1_pInt,myStructure))+k, &
- myStructure), i )
- enddo; enddo
-
- do o = 1_pInt,lattice_maxNtwinFamily
- index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,i))
- do k = 1_pInt,constitutive_dislotwin_Ntwin(o,i) ! loop over (active) systems in other family (twin)
- constitutive_dislotwin_interactionMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,i) = &
- constitutive_dislotwin_interaction_TwinTwin(lattice_interactionTwinTwin( &
- sum(lattice_NtwinSystem(1:f-1_pInt,myStructure))+j, &
- sum(lattice_NtwinSystem(1:o-1_pInt,myStructure))+k, &
- myStructure), i )
- enddo; enddo
-
- enddo ! twin system in family
- enddo ! twin families
-
-enddo ! instances
-
+
+ do o = 1_pInt,lattice_maxNslipFamily
+ index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,i))
+ do k = 1_pInt,constitutive_dislotwin_Nslip(o,i) ! loop over (active) systems in other family (slip)
+ constitutive_dislotwin_interactionMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,i) = &
+ constitutive_dislotwin_interaction_TwinSlip(lattice_interactionTwinSlip( &
+ sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, &
+ sum(lattice_NslipSystem(1:o-1_pInt,structID))+k, &
+ structID), i )
+ enddo; enddo
+
+ do o = 1_pInt,lattice_maxNtwinFamily
+ index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,i))
+ do k = 1_pInt,constitutive_dislotwin_Ntwin(o,i) ! loop over (active) systems in other family (twin)
+ constitutive_dislotwin_interactionMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,i) = &
+ constitutive_dislotwin_interaction_TwinTwin(lattice_interactionTwinTwin( &
+ sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, &
+ sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, &
+ structID), i )
+ enddo; enddo
+
+ enddo ! twin system in family
+ enddo ! twin families
+
+ enddo instancesLoop
+
end subroutine constitutive_dislotwin_init
-function constitutive_dislotwin_stateInit(myInstance)
-!*********************************************************************
-!* initial microstructural state *
-!*********************************************************************
-use prec, only: pReal,pInt
-use math, only: pi
-use lattice, only: lattice_maxNslipFamily
-implicit none
-
-!* Input-Output variables
-integer(pInt) :: myInstance
-real(pReal), dimension(constitutive_dislotwin_sizeState(myInstance)) :: constitutive_dislotwin_stateInit
-!* Local variables
-integer(pInt) :: i,j,f,ns,nt, index_myFamily
-real(pReal), dimension(constitutive_dislotwin_totalNslip(myInstance)) :: rhoEdge0, &
- rhoEdgeDip0, &
- invLambdaSlip0, &
- MeanFreePathSlip0, &
- tauSlipThreshold0
-real(pReal), dimension(constitutive_dislotwin_totalNtwin(myInstance)) :: MeanFreePathTwin0,TwinVolume0
-
-ns = constitutive_dislotwin_totalNslip(myInstance)
-nt = constitutive_dislotwin_totalNtwin(myInstance)
-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,myInstance)) ! index in truncated slip system list
- rhoEdge0(index_myFamily+1_pInt: &
- index_myFamily+constitutive_dislotwin_Nslip(f,myInstance)) = &
- constitutive_dislotwin_rhoEdge0(f,myInstance)
- rhoEdgeDip0(index_myFamily+1_pInt: &
- index_myFamily+constitutive_dislotwin_Nslip(f,myInstance)) = &
- constitutive_dislotwin_rhoEdgeDip0(f,myInstance)
-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,myInstance)))/ &
- constitutive_dislotwin_CLambdaSlipPerSlipSystem(i,myInstance)
-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(myInstance)/(1.0_pReal+invLambdaSlip0(i)*constitutive_dislotwin_GrainSize(myInstance))
-constitutive_dislotwin_stateInit(5_pInt*ns+3_pInt*nt+1:6_pInt*ns+3_pInt*nt) = MeanFreePathSlip0
-
-forall (i = 1_pInt:ns) &
- tauSlipThreshold0(i) = constitutive_dislotwin_SolidSolutionStrength(myInstance) + &
- constitutive_dislotwin_Gmod(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(i,myInstance) * &
- sqrt(dot_product((rhoEdge0+rhoEdgeDip0),constitutive_dislotwin_interactionMatrix_SlipSlip(i,1:ns,myInstance)))
-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(myInstance)
-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,myInstance)*MeanFreePathTwin0(j)**(2.0_pReal)
-constitutive_dislotwin_stateInit(7_pInt*ns+5_pInt*nt+1_pInt:7_pInt*ns+6_pInt*nt) = TwinVolume0
-
-!write(6,*) '#STATEINIT#'
-!write(6,*)
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'RhoEdge',rhoEdge0
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'RhoEdgedip',rhoEdgeDip0
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'invLambdaSlip',invLambdaSlip0
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'MeanFreePathSlip',MeanFreePathSlip0
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'tauSlipThreshold', tauSlipThreshold0
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'MeanFreePathTwin', MeanFreePathTwin0
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'TwinVolume', TwinVolume0
-
-end function
-
-
!--------------------------------------------------------------------------------------------------
-!> @brief absolute state tolerance
+!> @brief sets the initial microstructural state for a given instance of this plasticity
!--------------------------------------------------------------------------------------------------
-pure function constitutive_dislotwin_aTolState(myInstance)
+function constitutive_dislotwin_stateInit(matID)
+ use math, only: &
+ pi
+ use lattice, only: &
+ lattice_maxNslipFamily
+
implicit none
- integer(pInt), intent(in) :: myInstance ! number specifying the current instance of the plasticity
- real(pReal), dimension(constitutive_dislotwin_sizeState(myInstance)) :: &
- constitutive_dislotwin_aTolState ! relevant state values for the current instance of this plasticity
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
+
+ real(pReal), dimension(constitutive_dislotwin_sizeState(matID)) :: &
+ constitutive_dislotwin_stateInit
+
+ integer(pInt) :: i,j,f,ns,nt, index_myFamily
+ real(pReal), dimension(constitutive_dislotwin_totalNslip(matID)) :: &
+ rhoEdge0, &
+ rhoEdgeDip0, &
+ invLambdaSlip0, &
+ MeanFreePathSlip0, &
+ tauSlipThreshold0
+ real(pReal), dimension(constitutive_dislotwin_totalNtwin(matID)) :: &
+ MeanFreePathTwin0,TwinVolume0
+
+ ns = constitutive_dislotwin_totalNslip(matID)
+ nt = constitutive_dislotwin_totalNtwin(matID)
+ 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,matID)) ! index in truncated slip system list
+ rhoEdge0(index_myFamily+1_pInt: &
+ index_myFamily+constitutive_dislotwin_Nslip(f,matID)) = &
+ constitutive_dislotwin_rhoEdge0(f,matID)
+ rhoEdgeDip0(index_myFamily+1_pInt: &
+ index_myFamily+constitutive_dislotwin_Nslip(f,matID)) = &
+ constitutive_dislotwin_rhoEdgeDip0(f,matID)
+ 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,matID)))/ &
+ constitutive_dislotwin_CLambdaSlipPerSlipSystem(i,matID)
+ 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(matID)/(1.0_pReal+invLambdaSlip0(i)*constitutive_dislotwin_GrainSize(matID))
+ constitutive_dislotwin_stateInit(5_pInt*ns+3_pInt*nt+1:6_pInt*ns+3_pInt*nt) = MeanFreePathSlip0
+
+ forall (i = 1_pInt:ns) &
+ tauSlipThreshold0(i) = constitutive_dislotwin_SolidSolutionStrength(matID) + &
+ constitutive_dislotwin_Gmod(matID)*constitutive_dislotwin_burgersPerSlipSystem(i,matID) * &
+ sqrt(dot_product((rhoEdge0+rhoEdgeDip0),constitutive_dislotwin_interactionMatrix_SlipSlip(i,1:ns,matID)))
+ 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(matID)
+ 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,matID)*MeanFreePathTwin0(j)**(2.0_pReal)
+ constitutive_dislotwin_stateInit(7_pInt*ns+5_pInt*nt+1_pInt:7_pInt*ns+6_pInt*nt) = TwinVolume0
+
+ !write(6,*) '#STATEINIT#'
+ !write(6,*)
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'RhoEdge',rhoEdge0
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'RhoEdgedip',rhoEdgeDip0
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'invLambdaSlip',invLambdaSlip0
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'MeanFreePathSlip',MeanFreePathSlip0
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'tauSlipThreshold', tauSlipThreshold0
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'MeanFreePathTwin', MeanFreePathTwin0
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'TwinVolume', TwinVolume0
+
+end function constitutive_dislotwin_stateInit
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief sets the relevant state values for a given instance of this plasticity
+!--------------------------------------------------------------------------------------------------
+pure function constitutive_dislotwin_aTolState(matID)
+
+ implicit none
+ integer(pInt), intent(in) :: &
+ matID ! number specifying the current instance of the plasticity
+ real(pReal), dimension(constitutive_dislotwin_sizeState(matID)) :: &
+ constitutive_dislotwin_aTolState ! relevant state values for the current instance of this plasticity
! Tolerance state for dislocation densities
- constitutive_dislotwin_aTolState(1_pInt:2_pInt*constitutive_dislotwin_totalNslip(myInstance)) = &
- constitutive_dislotwin_aTolRho(myInstance)
+ constitutive_dislotwin_aTolState(1_pInt:2_pInt*constitutive_dislotwin_totalNslip(matID)) = &
+ constitutive_dislotwin_aTolRho(matID)
! Tolerance state for accumulated shear due to slip
- constitutive_dislotwin_aTolState(2_pInt*constitutive_dislotwin_totalNslip(myInstance)+1_pInt: &
- 3_pInt*constitutive_dislotwin_totalNslip(myInstance))=1e6_pReal
+ constitutive_dislotwin_aTolState(2_pInt*constitutive_dislotwin_totalNslip(matID)+1_pInt: &
+ 3_pInt*constitutive_dislotwin_totalNslip(matID))=1e6_pReal
! Tolerance state for twin volume fraction
- constitutive_dislotwin_aTolState(3_pInt*constitutive_dislotwin_totalNslip(myInstance)+1_pInt: &
- 3_pInt*constitutive_dislotwin_totalNslip(myInstance)+&
- constitutive_dislotwin_totalNtwin(myInstance)) = &
- constitutive_dislotwin_aTolTwinFrac(myInstance)
+ constitutive_dislotwin_aTolState(3_pInt*constitutive_dislotwin_totalNslip(matID)+1_pInt: &
+ 3_pInt*constitutive_dislotwin_totalNslip(matID)+&
+ constitutive_dislotwin_totalNtwin(matID)) = &
+ constitutive_dislotwin_aTolTwinFrac(matID)
! Tolerance state for accumulated shear due to twin
- constitutive_dislotwin_aTolState(3_pInt*constitutive_dislotwin_totalNslip(myInstance)+ &
- constitutive_dislotwin_totalNtwin(myInstance)+1_pInt: &
- 3_pInt*constitutive_dislotwin_totalNslip(myInstance)+ &
- 2_pInt*constitutive_dislotwin_totalNtwin(myInstance)) = 1e6_pReal
+ constitutive_dislotwin_aTolState(3_pInt*constitutive_dislotwin_totalNslip(matID)+ &
+ constitutive_dislotwin_totalNtwin(matID)+1_pInt: &
+ 3_pInt*constitutive_dislotwin_totalNslip(matID)+ &
+ 2_pInt*constitutive_dislotwin_totalNtwin(matID)) = 1e6_pReal
end function constitutive_dislotwin_aTolState
-
-pure function constitutive_dislotwin_homogenizedC(state,g,ip,el)
-!*********************************************************************
-!* calculates homogenized elacticity matrix *
-!* - state : microstructure quantities *
-!* - g : component-ID of current integration point *
-!* - ip : current integration point *
-!* - el : current element *
-!*********************************************************************
-use prec, only: pReal,pInt,p_vec
-use mesh, only: mesh_NcpElems,mesh_maxNips
-use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance
-implicit none
-
-!* Input-Output variables
-integer(pInt), intent(in) :: g,ip,el
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state
-real(pReal), dimension(6,6) :: constitutive_dislotwin_homogenizedC
-!* Local variables
-integer(pInt) myInstance,ns,nt,i
-real(pReal) sumf
-
-!* Shortened notation
-myInstance = phase_plasticityInstance(material_phase(g,ip,el))
-ns = constitutive_dislotwin_totalNslip(myInstance)
-nt = constitutive_dislotwin_totalNtwin(myInstance)
-
-!* Total twin volume fraction
-sumf = sum(state(g,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
-
-!* Homogenized elasticity matrix
-constitutive_dislotwin_homogenizedC = (1.0_pReal-sumf)*constitutive_dislotwin_Cslip_66(:,:,myInstance)
-do i=1_pInt,nt
- constitutive_dislotwin_homogenizedC = &
- constitutive_dislotwin_homogenizedC + state(g,ip,el)%p(3_pInt*ns+i)*constitutive_dislotwin_Ctwin_66(:,:,i,myInstance)
-enddo
-
-end function
-
-
-subroutine constitutive_dislotwin_microstructure(Temperature,state,g,ip,el)
-!*********************************************************************
-!* calculates quantities characterizing the microstructure *
-!* - Temperature : temperature *
-!* - state : microstructure quantities *
-!* - ipc : component-ID of current integration point *
-!* - ip : current integration point *
-!* - el : current element *
-!*********************************************************************
-use prec, only: pReal,pInt,p_vec
-use math, only: pi
-use mesh, only: mesh_NcpElems,mesh_maxNips
-use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance
-!use debug, only: debugger
-implicit none
-
-!* Input-Output variables
-integer(pInt), intent(in) :: g,ip,el
-real(pReal), intent(in) :: Temperature
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: state
-!* Local variables
-integer(pInt) myInstance,myStructure,ns,nt,s,t
-real(pReal) sumf,sfe,x0
-real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: fOverStacksize
-
-!* Shortened notation
-myInstance = phase_plasticityInstance(material_phase(g,ip,el))
-myStructure = constitutive_dislotwin_structure(myInstance)
-ns = constitutive_dislotwin_totalNslip(myInstance)
-nt = constitutive_dislotwin_totalNtwin(myInstance)
-!* State: 1 : ns rho_edge
-!* State: ns+1 : 2*ns rho_dipole
-!* State: 2*ns+1 : 3*ns accumulated shear due to slip
-!* State: 3*ns+1 : 3*ns+nt f
-!* State: 3*ns+nt+1 : 3*ns+2*nt accumulated shear due to twin
-!* State: 3*ns+2*nt+1 : 4*ns+2*nt 1/lambda_slip
-!* State: 4*ns+2*nt+1 : 5*ns+2*nt 1/lambda_sliptwin
-!* State: 5*ns+2*nt+1 : 5*ns+3*nt 1/lambda_twin
-!* State: 5*ns+3*nt+1 : 6*ns+3*nt mfp_slip
-!* State: 6*ns+3*nt+1 : 6*ns+4*nt mfp_twin
-!* State: 6*ns+4*nt+1 : 7*ns+4*nt threshold_stress_slip
-!* State: 7*ns+4*nt+1 : 7*ns+5*nt threshold_stress_twin
-!* State: 7*ns+5*nt+1 : 7*ns+6*nt twin volume
-
-!* Total twin volume fraction
-sumf = sum(state(g,ip,el)%p((3*ns+1):(3*ns+nt))) ! safe for nt == 0
-
-!* Stacking fault energy
-sfe = constitutive_dislotwin_SFE_0K(myInstance) + &
- constitutive_dislotwin_dSFE_dT(myInstance) * Temperature
-
-!* rescaled twin volume fraction for topology
-forall (t = 1_pInt:nt) &
- fOverStacksize(t) = &
- state(g,ip,el)%p(3_pInt*ns+t)/constitutive_dislotwin_twinsizePerTwinSystem(t,myInstance)
-
-!* 1/mean free distance between 2 forest dislocations seen by a moving dislocation
-forall (s = 1_pInt:ns) &
- state(g,ip,el)%p(3_pInt*ns+2_pInt*nt+s) = &
- sqrt(dot_product((state(g,ip,el)%p(1:ns)+state(g,ip,el)%p(ns+1_pInt:2_pInt*ns)),&
- constitutive_dislotwin_forestProjectionEdge(1:ns,s,myInstance)))/ &
- constitutive_dislotwin_CLambdaSlipPerSlipSystem(s,myInstance)
-
-!* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation
-!$OMP CRITICAL (evilmatmul)
-state(g,ip,el)%p((4_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+2_pInt*nt)) = 0.0_pReal
-if (nt > 0_pInt .and. ns > 0_pInt) &
- state(g,ip,el)%p((4_pInt*ns+2_pInt*nt+1):(5_pInt*ns+2_pInt*nt)) = &
- matmul(constitutive_dislotwin_interactionMatrix_SlipTwin(1:ns,1:nt,myInstance),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) &
- state(g,ip,el)%p((5_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+3_pInt*nt)) = &
- matmul(constitutive_dislotwin_interactionMatrix_TwinTwin(1:nt,1:nt,myInstance),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
- state(g,ip,el)%p(5_pInt*ns+3_pInt*nt+s) = &
- constitutive_dislotwin_GrainSize(myInstance)/(1.0_pReal+constitutive_dislotwin_GrainSize(myInstance)*&
- (state(g,ip,el)%p(3_pInt*ns+2_pInt*nt+s)+state(g,ip,el)%p(4_pInt*ns+2_pInt*nt+s)))
- else
- state(g,ip,el)%p(5_pInt*ns+s) = &
- constitutive_dislotwin_GrainSize(myInstance)/&
- (1.0_pReal+constitutive_dislotwin_GrainSize(myInstance)*(state(g,ip,el)%p(3_pInt*ns+s)))
- endif
-enddo
-
-!* mean free path between 2 obstacles seen by a growing twin
-forall (t = 1_pInt:nt) &
- state(g,ip,el)%p(6_pInt*ns+3_pInt*nt+t) = &
- (constitutive_dislotwin_Cmfptwin(myInstance)*constitutive_dislotwin_GrainSize(myInstance))/&
- (1.0_pReal+constitutive_dislotwin_GrainSize(myInstance)*state(g,ip,el)%p(5_pInt*ns+2_pInt*nt+t))
-
-!* threshold stress for dislocation motion
-forall (s = 1_pInt:ns) &
- state(g,ip,el)%p(6_pInt*ns+4_pInt*nt+s) = constitutive_dislotwin_SolidSolutionStrength(myInstance)+ &
- constitutive_dislotwin_Gmod(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(s,myInstance)*&
- sqrt(dot_product((state(g,ip,el)%p(1:ns)+state(g,ip,el)%p(ns+1_pInt:2_pInt*ns)),&
- constitutive_dislotwin_interactionMatrix_SlipSlip(s,1:ns,myInstance)))
-
-!* threshold stress for growing twin
-forall (t = 1_pInt:nt) &
- state(g,ip,el)%p(7_pInt*ns+4_pInt*nt+t) = &
- constitutive_dislotwin_Cthresholdtwin(myInstance)*&
- (sfe/(3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,myInstance))+&
- 3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,myInstance)*constitutive_dislotwin_Gmod(myInstance)/&
- (constitutive_dislotwin_L0(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(t,myInstance)))
-
-!* final twin volume after growth
-forall (t = 1_pInt:nt) &
- state(g,ip,el)%p(7_pInt*ns+5_pInt*nt+t) = &
- (pi/4.0_pReal)*constitutive_dislotwin_twinsizePerTwinSystem(t,myInstance)*state(g,ip,el)%p(6*ns+3*nt+t)**(2.0_pReal)
-
-!* equilibrium seperation of partial dislocations
-do t = 1_pInt,nt
- x0 = constitutive_dislotwin_Gmod(myInstance)*constitutive_dislotwin_burgersPerTwinSystem(t,myInstance)**(2.0_pReal)/&
- (sfe*8.0_pReal*pi)*(2.0_pReal+constitutive_dislotwin_nu(myInstance))/(1.0_pReal-constitutive_dislotwin_nu(myInstance))
- constitutive_dislotwin_tau_r(t,myInstance)= &
- constitutive_dislotwin_Gmod(myInstance)*constitutive_dislotwin_burgersPerTwinSystem(t,myInstance)/(2.0_pReal*pi)*&
- (1/(x0+constitutive_dislotwin_xc(myInstance))+cos(pi/3.0_pReal)/x0)
-enddo
-
-!if ((ip==1).and.(el==1)) then
-! write(6,*) '#MICROSTRUCTURE#'
-! write(6,*)
-! write(6,'(a,/,4(3(f10.4,1x)/))') 'rhoEdge',state(g,ip,el)%p(1:ns)/1e9
-! write(6,'(a,/,4(3(f10.4,1x)/))') 'rhoEdgeDip',state(g,ip,el)%p(ns+1:2*ns)/1e9
-! write(6,'(a,/,4(3(f10.4,1x)/))') 'Fraction',state(g,ip,el)%p(2*ns+1:2*ns+nt)
-!endif
-
-end subroutine
-
-
-subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,state,g,ip,el)
-!*********************************************************************
-!* calculates plastic velocity gradient and its tangent *
-!* INPUT: *
-!* - Temperature : temperature *
-!* - state : microstructure quantities *
-!* - Tstar_v : 2nd Piola Kirchhoff stress tensor (Mandel) *
-!* - ipc : component-ID at current integration point *
-!* - ip : current integration point *
-!* - el : current element *
-!* OUTPUT: *
-!* - Lp : plastic velocity gradient *
-!* - dLp_dTstar : derivative of Lp (4th-rank tensor) *
-!*********************************************************************
-use prec, only: pReal,pInt,p_vec
-use math, only: math_Plain3333to99, math_Mandel6to33, math_Mandel33to6, &
- math_spectralDecompositionSym33, math_tensorproduct, math_symmetric33,math_mul33x3
-use mesh, only: mesh_NcpElems,mesh_maxNips
-use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance
-use lattice, only: lattice_Sslip,lattice_Sslip_v,lattice_Stwin,lattice_Stwin_v,lattice_maxNslipFamily,lattice_maxNtwinFamily, &
- lattice_NslipSystem,lattice_NtwinSystem,lattice_shearTwin,lattice_fcc_corellationTwinSlip
-
-implicit none
-
-!* Input-Output variables
-integer(pInt), intent(in) :: g,ip,el
-real(pReal), intent(in) :: Temperature
-real(pReal), dimension(6), intent(in) :: Tstar_v
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: state
-real(pReal), dimension(3,3), intent(out) :: Lp
-real(pReal), dimension(9,9), intent(out) :: dLp_dTstar
-!* Local variables
-integer(pInt) myInstance,myStructure,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(g,ip,el)))) :: &
- gdot_slip,dgdot_dtauslip,tau_slip
-real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: &
- gdot_twin,dgdot_dtautwin,tau_twin
-real(pReal), dimension(6) :: gdot_sb,dgdot_dtausb,tau_sb
-real(pReal), dimension(3,3) :: eigVectors, sb_Smatrix
-real(pReal), dimension(3) :: eigValues, sb_s, sb_m
-real(pReal), dimension(3,6), parameter :: &
- sb_sComposition = &
- reshape(real([&
- 1, 0, 1, &
- 1, 0,-1, &
- 1, 1, 0, &
- 1,-1, 0, &
- 0, 1, 1, &
- 0, 1,-1 &
- ],pReal),[ 3,6]), &
- sb_mComposition = &
- reshape(real([&
- 1, 0,-1, &
- 1, 0,+1, &
- 1,-1, 0, &
- 1, 1, 0, &
- 0, 1,-1, &
- 0, 1, 1 &
- ],pReal),[ 3,6])
-logical error
-
-!* Shortened notation
-myInstance = phase_plasticityInstance(material_phase(g,ip,el))
-myStructure = constitutive_dislotwin_structure(myInstance)
-ns = constitutive_dislotwin_totalNslip(myInstance)
-nt = constitutive_dislotwin_totalNtwin(myInstance)
-
-!* Total twin volume fraction
-sumf = sum(state(g,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
-
-Lp = 0.0_pReal
-dLp_dTstar3333 = 0.0_pReal
-dLp_dTstar = 0.0_pReal
-
-!* Dislocation glide part
-gdot_slip = 0.0_pReal
-dgdot_dtauslip = 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,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Nslip(f,myInstance) ! 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,myStructure))
-
- !* Stress ratios
- StressRatio_p = (abs(tau_slip(j))/state(g,ip,el)%p(6*ns+4*nt+j))**constitutive_dislotwin_p(myInstance)
- StressRatio_pminus1 = (abs(tau_slip(j))/state(g,ip,el)%p(6*ns+4*nt+j))**(constitutive_dislotwin_p(myInstance)-1.0_pReal)
- !* Boltzmann ratio
- BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,myInstance)/(kB*Temperature)
- !* Initial shear rates
- DotGamma0 = &
- state(g,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance)*&
- constitutive_dislotwin_v0PerSlipSystem(j,myInstance)
-
- !* Shear rates due to slip
- gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1-StressRatio_p)**constitutive_dislotwin_q(myInstance))*&
- sign(1.0_pReal,tau_slip(j))
-
- !* Derivatives of shear rates
- dgdot_dtauslip(j) = &
- ((abs(gdot_slip(j))*BoltzmannRatio*&
- constitutive_dislotwin_p(myInstance)*constitutive_dislotwin_q(myInstance))/state(g,ip,el)%p(6*ns+4*nt+j))*&
- StressRatio_pminus1*(1-StressRatio_p)**(constitutive_dislotwin_q(myInstance)-1.0_pReal)
-
- !* Plastic velocity gradient for dislocation glide
- Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(:,:,1,index_myFamily+i,myStructure)
-
- !* 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,myStructure)*&
- lattice_Sslip(m,n,1,index_myFamily+i,myStructure)
- enddo
-enddo
-
-!* Shear banding (shearband) part
-if(constitutive_dislotwin_sbVelocity(myInstance) /= 0.0_pReal .or. &
- constitutive_dislotwin_sbResistance(myInstance) /= 0.0_pReal) then
- gdot_sb = 0.0_pReal
- dgdot_dtausb = 0.0_pReal
- call math_spectralDecompositionSym33(math_Mandel6to33(Tstar_v),eigValues,eigVectors, error)
- do j = 1_pInt,6_pInt
- sb_s = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_sComposition(1:3,j))
- sb_m = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_mComposition(1:3,j))
- sb_Smatrix = math_tensorproduct(sb_s,sb_m)
- constitutive_dislotwin_sbSv(1:6,j,g,ip,el) = math_Mandel33to6(math_symmetric33(sb_Smatrix))
-
- !* Calculation of Lp
- !* Resolved shear stress on shear banding system
- tau_sb(j) = dot_product(Tstar_v,constitutive_dislotwin_sbSv(1:6,j,g,ip,el))
-
- ! if (debug_selectiveDebugger .and. g==debug_g .and. ip==debug_i .and. el==debug_e) then
- ! write(6,'(a,3(i3,1x),a,i1,a,e10.3)') '### TAU SHEARBAND at g ip el ',g,ip,el,' on family ',j,' : ',tau
- ! endif
-
- !* Stress ratios
- StressRatio_p = (abs(tau_sb(j))/constitutive_dislotwin_sbResistance(myInstance))**constitutive_dislotwin_p(myInstance)
- StressRatio_pminus1 = (abs(tau_sb(j))/constitutive_dislotwin_sbResistance(myInstance))&
- **(constitutive_dislotwin_p(myInstance)-1.0_pReal)
- !* Boltzmann ratio
- BoltzmannRatio = constitutive_dislotwin_sbQedge(myInstance)/(kB*Temperature)
- !* Initial shear rates
- DotGamma0 = constitutive_dislotwin_sbVelocity(myInstance)
-
- !* Shear rates due to shearband
- gdot_sb(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(myInstance))*&
- sign(1.0_pReal,tau_sb(j))
-
- !* Derivatives of shear rates
- dgdot_dtausb(j) = &
- ((abs(gdot_sb(j))*BoltzmannRatio*&
- constitutive_dislotwin_p(myInstance)*constitutive_dislotwin_q(myInstance))/constitutive_dislotwin_sbResistance(myInstance))*&
- StressRatio_pminus1*(1_pInt-StressRatio_p)**(constitutive_dislotwin_q(myInstance)-1.0_pReal)
-
- !* Plastic velocity gradient for shear banding
- Lp = Lp + gdot_sb(j)*sb_Smatrix
-
- !* 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_dtausb(j)*&
- sb_Smatrix(k,l)*&
- sb_Smatrix(m,n)
- enddo
-end if
-
-!* Mechanical twinning part
-gdot_twin = 0.0_pReal
-dgdot_dtautwin = 0.0_pReal
-j = 0_pInt
-do f = 1_pInt,lattice_maxNtwinFamily ! loop over all slip families
- index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Ntwin(f,myInstance) ! 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,myStructure))
-
- !* Stress ratios
- StressRatio_r = (state(g,ip,el)%p(7*ns+4*nt+j)/tau_twin(j))**constitutive_dislotwin_r(myInstance)
-
- !* Shear rates and their derivatives due to twin
- if ( tau_twin(j) > 0.0_pReal ) then
- select case(constitutive_dislotwin_structureName(myInstance))
- case ('fcc')
- s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i)
- s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i)
- if (tau_twin(j) < constitutive_dislotwin_tau_r(j,myInstance)) then
- Ndot0=(abs(gdot_slip(s1))*(state(g,ip,el)%p(s2)+state(g,ip,el)%p(ns+s2))+&
- abs(gdot_slip(s2))*(state(g,ip,el)%p(s1)+state(g,ip,el)%p(ns+s1)))/&
- (constitutive_dislotwin_L0(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance))*&
- (1-exp(-constitutive_dislotwin_VcrossSlip(myInstance)/(kB*Temperature)*&
- (constitutive_dislotwin_tau_r(j,myInstance)-tau_twin(j))))
- else
- Ndot0=0.0_pReal
- end if
- case default
- Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,myInstance)
- end select
- gdot_twin(j) = &
- (constitutive_dislotwin_MaxTwinFraction(myInstance)-sumf)*lattice_shearTwin(index_myFamily+i,myStructure)*&
- state(g,ip,el)%p(7*ns+5*nt+j)*Ndot0*exp(-StressRatio_r)
- dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_dislotwin_r(myInstance))/tau_twin(j))*StressRatio_r
- endif
-
- !* Plastic velocity gradient for mechanical twinning
- Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,myStructure)
-
- !* 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,myStructure)*&
- lattice_Stwin(m,n,index_myFamily+i,myStructure)
- enddo
-enddo
-
-dLp_dTstar = math_Plain3333to99(dLp_dTstar3333)
-
-!if ((ip==1).and.(el==1)) then
-! write(6,*) '#LP/TANGENT#'
-! write(6,*)
-! write(6,*) 'Tstar_v', Tstar_v
-! write(6,*) 'tau_slip', tau_slip
-! write(6,'(a10,/,4(3(e20.8,1x),/))') 'state',state(1,1,1)%p
-! write(6,'(a,/,3(3(f10.4,1x)/))') 'Lp',Lp
-! write(6,'(a,/,9(9(f10.4,1x)/))') 'dLp_dTstar',dLp_dTstar
-!endif
-
-end subroutine
-
-
-function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,g,ip,el)
-!*********************************************************************
-!* rate of change of microstructure *
-!* INPUT: *
-!* - Temperature : temperature *
-!* - state : microstructure quantities *
-!* - Tstar_v : 2nd Piola Kirchhoff stress tensor (Mandel) *
-!* - ipc : component-ID at current integration point *
-!* - ip : current integration point *
-!* - el : current element *
-!* OUTPUT: *
-!* - constitutive_dotState : evolution of state variable *
-!*********************************************************************
-use prec, only: pReal,pInt,p_vec
-
-use math, only: pi
-use mesh, only: mesh_NcpElems, mesh_maxNips
-use material, only: homogenization_maxNgrains, material_phase, phase_plasticityInstance
-use lattice, only: lattice_Sslip_v, lattice_Stwin_v, &
- lattice_maxNslipFamily,lattice_maxNtwinFamily, &
- lattice_NslipSystem, lattice_NtwinSystem, lattice_sheartwin, lattice_fcc_corellationTwinSlip
-implicit none
-
-!* Input-Output variables
-integer(pInt), intent(in) :: g,ip,el
-real(pReal), intent(in) :: Temperature
-real(pReal), dimension(6), intent(in) :: Tstar_v
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state
-real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(g,ip,el)))) :: &
-constitutive_dislotwin_dotState
-!* Local variables
-integer(pInt) MyInstance,MyStructure,ns,nt,f,i,j,index_myFamily,s1,s2
-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(g,ip,el)))) :: &
-gdot_slip,tau_slip,DotRhoMultiplication,EdgeDipDistance,DotRhoEdgeEdgeAnnihilation,DotRhoEdgeDipAnnihilation,&
-ClimbVelocity,DotRhoEdgeDipClimb,DotRhoDipFormation
-real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(g,ip,el)))) :: &
- tau_twin
-
-!* Shortened notation
-myInstance = phase_plasticityInstance(material_phase(g,ip,el))
-MyStructure = constitutive_dislotwin_structure(myInstance)
-ns = constitutive_dislotwin_totalNslip(myInstance)
-nt = constitutive_dislotwin_totalNtwin(myInstance)
-
-!* Total twin volume fraction
-sumf = sum(state(g,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
-
-constitutive_dislotwin_dotState = 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,MyStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Nslip(f,myInstance) ! 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,myStructure))
- !* Stress ratios
- StressRatio_p = (abs(tau_slip(j))/state(g,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
- constitutive_dislotwin_p(myInstance)
- StressRatio_pminus1 = (abs(tau_slip(j))/state(g,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
- (constitutive_dislotwin_p(myInstance)-1.0_pReal)
- !* Boltzmann ratio
- BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,myInstance)/(kB*Temperature)
- !* Initial shear rates
- DotGamma0 = &
- state(g,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance)*&
- constitutive_dislotwin_v0PerSlipSystem(j,myInstance)
-
- !* Shear rates due to slip
- gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(myInstance))*&
- sign(1.0_pReal,tau_slip(j))
-
- !* Multiplication
- DotRhoMultiplication(j) = abs(gdot_slip(j))/&
- (constitutive_dislotwin_burgersPerSlipSystem(j,myInstance)*state(g,ip,el)%p(5*ns+3*nt+j))
-
- !* Dipole formation
- EdgeDipMinDistance = &
- constitutive_dislotwin_CEdgeDipMinDistance(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance)
- if (tau_slip(j) == 0.0_pReal) then
- DotRhoDipFormation(j) = 0.0_pReal
- else
- EdgeDipDistance(j) = &
- (3.0_pReal*constitutive_dislotwin_Gmod(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance))/&
- (16.0_pReal*pi*abs(tau_slip(j)))
- if (EdgeDipDistance(j)>state(g,ip,el)%p(5*ns+3*nt+j)) EdgeDipDistance(j)=state(g,ip,el)%p(5*ns+3*nt+j)
- if (EdgeDipDistance(j) 0.0_pReal ) then
- select case(constitutive_dislotwin_structureName(myInstance))
- case ('fcc')
- s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i)
- s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i)
- if (tau_twin(j) < constitutive_dislotwin_tau_r(j,myInstance)) then
- Ndot0=(abs(gdot_slip(s1))*(state(g,ip,el)%p(s2)+state(g,ip,el)%p(ns+s2))+&
- abs(gdot_slip(s2))*(state(g,ip,el)%p(s1)+state(g,ip,el)%p(ns+s1)))/&
- (constitutive_dislotwin_L0(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance))*&
- (1-exp(-constitutive_dislotwin_VcrossSlip(myInstance)/(kB*Temperature)*&
- (constitutive_dislotwin_tau_r(j,myInstance)-tau_twin(j))))
- else
- Ndot0=0.0_pReal
- end if
- case default
- Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,myInstance)
- end select
- constitutive_dislotwin_dotState(3_pInt*ns+j) = &
- (constitutive_dislotwin_MaxTwinFraction(myInstance)-sumf)*&
- state(g,ip,el)%p(7_pInt*ns+5_pInt*nt+j)*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,myStructure)
-
- endif
-
- enddo
-enddo
-
-!write(6,*) '#DOTSTATE#'
-!write(6,*)
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'tau slip',tau_slip
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'gamma slip',gdot_slip
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'RhoEdge',state(g,ip,el)%p(1:ns)
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'Threshold Slip', state(g,ip,el)%p(5*ns+3*nt+1:6*ns+3*nt)
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'Multiplication',DotRhoMultiplication
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'DipFormation',DotRhoDipFormation
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'SingleSingle',DotRhoEdgeEdgeAnnihilation
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'SingleDipole',DotRhoEdgeDipAnnihilation
-!write(6,'(a,/,4(3(f30.20,1x)/))') 'DipClimb',DotRhoEdgeDipClimb
-
-end function
-
-
-!*********************************************************************
-!* (instantaneous) incremental change of microstructure *
-!*********************************************************************
-function constitutive_dislotwin_deltaState(Tstar_v, Temperature, state, g,ip,el)
-
-use prec, only: pReal, &
- pInt, &
- p_vec
-use mesh, only: mesh_NcpElems, &
- mesh_maxNips
-use material, only: homogenization_maxNgrains, &
- material_phase, &
- phase_plasticityInstance
-
-implicit none
-
-!*** input variables
-integer(pInt), intent(in) :: g, & ! current grain number
- ip, & ! current integration point
- el ! current element number
-real(pReal), intent(in) :: Temperature ! temperature
-real(pReal), dimension(6), intent(in) :: Tstar_v ! current 2nd Piola-Kirchhoff stress in Mandel notation
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
- state ! current microstructural state
-
-!*** output variables
-real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(g,ip,el)))) :: &
- constitutive_dislotwin_deltaState ! change of state variables / microstructure
+!--------------------------------------------------------------------------------------------------
+!> @brief returns the homogenized elasticity matrix
+!--------------------------------------------------------------------------------------------------
+pure function constitutive_dislotwin_homogenizedC(state,ipc,ip,el)
+ use prec, only: &
+ p_vec
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains, &
+ material_phase, &
+ phase_plasticityInstance
-!*** local variables
+ implicit none
+ real(pReal), dimension(6,6) :: &
+ constitutive_dislotwin_homogenizedC
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
+ state !< microstructure state
+
+ integer(pInt) :: matID,ns,nt,i
+ real(pReal) :: sumf
+
+ !* Shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ ns = constitutive_dislotwin_totalNslip(matID)
+ nt = constitutive_dislotwin_totalNtwin(matID)
+
+ !* Total twin volume fraction
+ sumf = sum(state(ipc,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
+
+ !* Homogenized elasticity matrix
+ constitutive_dislotwin_homogenizedC = (1.0_pReal-sumf)*constitutive_dislotwin_Cslip_66(:,:,matID)
+ do i=1_pInt,nt
+ constitutive_dislotwin_homogenizedC = &
+ constitutive_dislotwin_homogenizedC + state(ipc,ip,el)%p(3_pInt*ns+i)*constitutive_dislotwin_Ctwin_66(:,:,i,matID)
+ enddo
+
+ end function constitutive_dislotwin_homogenizedC
+
+!--------------------------------------------------------------------------------------------------
+!> @brief calculates derived quantities from state
+!--------------------------------------------------------------------------------------------------
+subroutine constitutive_dislotwin_microstructure(Temperature,state,ipc,ip,el)
+ use prec, only: &
+ p_vec
+ use math, only: &
+ pi
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains, &
+ material_phase, &
+ phase_plasticityInstance
+
+ implicit none
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ real(pReal), intent(in) :: &
+ temperature !< temperature at IP
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: &
+ state !< microstructure state
+
+ integer(pInt) :: &
+ matID,structID,&
+ ns,nt,s,t
+ real(pReal) :: &
+ sumf,sfe,x0
+ real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: fOverStacksize
+
+ !* Shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_dislotwin_structure(matID)
+ ns = constitutive_dislotwin_totalNslip(matID)
+ nt = constitutive_dislotwin_totalNtwin(matID)
+ !* State: 1 : ns rho_edge
+ !* State: ns+1 : 2*ns rho_dipole
+ !* State: 2*ns+1 : 3*ns accumulated shear due to slip
+ !* State: 3*ns+1 : 3*ns+nt f
+ !* State: 3*ns+nt+1 : 3*ns+2*nt accumulated shear due to twin
+ !* State: 3*ns+2*nt+1 : 4*ns+2*nt 1/lambda_slip
+ !* State: 4*ns+2*nt+1 : 5*ns+2*nt 1/lambda_sliptwin
+ !* State: 5*ns+2*nt+1 : 5*ns+3*nt 1/lambda_twin
+ !* State: 5*ns+3*nt+1 : 6*ns+3*nt mfp_slip
+ !* State: 6*ns+3*nt+1 : 6*ns+4*nt mfp_twin
+ !* State: 6*ns+4*nt+1 : 7*ns+4*nt threshold_stress_slip
+ !* State: 7*ns+4*nt+1 : 7*ns+5*nt threshold_stress_twin
+ !* State: 7*ns+5*nt+1 : 7*ns+6*nt twin volume
+
+ !* Total twin volume fraction
+ sumf = sum(state(ipc,ip,el)%p((3*ns+1):(3*ns+nt))) ! safe for nt == 0
+
+ !* Stacking fault energy
+ sfe = constitutive_dislotwin_SFE_0K(matID) + &
+ constitutive_dislotwin_dSFE_dT(matID) * Temperature
+
+ !* rescaled twin volume fraction for topology
+ forall (t = 1_pInt:nt) &
+ fOverStacksize(t) = &
+ state(ipc,ip,el)%p(3_pInt*ns+t)/constitutive_dislotwin_twinsizePerTwinSystem(t,matID)
+
+ !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation
+ forall (s = 1_pInt:ns) &
+ state(ipc,ip,el)%p(3_pInt*ns+2_pInt*nt+s) = &
+ sqrt(dot_product((state(ipc,ip,el)%p(1:ns)+state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)),&
+ constitutive_dislotwin_forestProjectionEdge(1:ns,s,matID)))/ &
+ constitutive_dislotwin_CLambdaSlipPerSlipSystem(s,matID)
+
+ !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation
+ !$OMP CRITICAL (evilmatmul)
+ state(ipc,ip,el)%p((4_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+2_pInt*nt)) = 0.0_pReal
+ if (nt > 0_pInt .and. ns > 0_pInt) &
+ state(ipc,ip,el)%p((4_pInt*ns+2_pInt*nt+1):(5_pInt*ns+2_pInt*nt)) = &
+ matmul(constitutive_dislotwin_interactionMatrix_SlipTwin(1:ns,1:nt,matID),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) &
+ state(ipc,ip,el)%p((5_pInt*ns+2_pInt*nt+1_pInt):(5_pInt*ns+3_pInt*nt)) = &
+ matmul(constitutive_dislotwin_interactionMatrix_TwinTwin(1:nt,1:nt,matID),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
+ state(ipc,ip,el)%p(5_pInt*ns+3_pInt*nt+s) = &
+ constitutive_dislotwin_GrainSize(matID)/(1.0_pReal+constitutive_dislotwin_GrainSize(matID)*&
+ (state(ipc,ip,el)%p(3_pInt*ns+2_pInt*nt+s)+state(ipc,ip,el)%p(4_pInt*ns+2_pInt*nt+s)))
+ else
+ state(ipc,ip,el)%p(5_pInt*ns+s) = &
+ constitutive_dislotwin_GrainSize(matID)/&
+ (1.0_pReal+constitutive_dislotwin_GrainSize(matID)*(state(ipc,ip,el)%p(3_pInt*ns+s)))
+ endif
+ enddo
+
+ !* mean free path between 2 obstacles seen by a growing twin
+ forall (t = 1_pInt:nt) &
+ state(ipc,ip,el)%p(6_pInt*ns+3_pInt*nt+t) = &
+ (constitutive_dislotwin_Cmfptwin(matID)*constitutive_dislotwin_GrainSize(matID))/&
+ (1.0_pReal+constitutive_dislotwin_GrainSize(matID)*state(ipc,ip,el)%p(5_pInt*ns+2_pInt*nt+t))
+
+ !* threshold stress for dislocation motion
+ forall (s = 1_pInt:ns) &
+ state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+s) = constitutive_dislotwin_SolidSolutionStrength(matID)+ &
+ constitutive_dislotwin_Gmod(matID)*constitutive_dislotwin_burgersPerSlipSystem(s,matID)*&
+ sqrt(dot_product((state(ipc,ip,el)%p(1:ns)+state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)),&
+ constitutive_dislotwin_interactionMatrix_SlipSlip(s,1:ns,matID)))
+
+ !* threshold stress for growing twin
+ forall (t = 1_pInt:nt) &
+ state(ipc,ip,el)%p(7_pInt*ns+4_pInt*nt+t) = &
+ constitutive_dislotwin_Cthresholdtwin(matID)*&
+ (sfe/(3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,matID))+&
+ 3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,matID)*constitutive_dislotwin_Gmod(matID)/&
+ (constitutive_dislotwin_L0(matID)*constitutive_dislotwin_burgersPerSlipSystem(t,matID)))
+
+ !* final twin volume after growth
+ forall (t = 1_pInt:nt) &
+ state(ipc,ip,el)%p(7_pInt*ns+5_pInt*nt+t) = &
+ (pi/4.0_pReal)*constitutive_dislotwin_twinsizePerTwinSystem(t,matID)*state(ipc,ip,el)%p(6*ns+3*nt+t)**(2.0_pReal)
+
+ !* equilibrium seperation of partial dislocations
+ do t = 1_pInt,nt
+ x0 = constitutive_dislotwin_Gmod(matID)*constitutive_dislotwin_burgersPerTwinSystem(t,matID)**(2.0_pReal)/&
+ (sfe*8.0_pReal*pi)*(2.0_pReal+constitutive_dislotwin_nu(matID))/(1.0_pReal-constitutive_dislotwin_nu(matID))
+ constitutive_dislotwin_tau_r(t,matID)= &
+ constitutive_dislotwin_Gmod(matID)*constitutive_dislotwin_burgersPerTwinSystem(t,matID)/(2.0_pReal*pi)*&
+ (1/(x0+constitutive_dislotwin_xc(matID))+cos(pi/3.0_pReal)/x0)
+ enddo
+
+ !if ((ip==1).and.(el==1)) then
+ ! write(6,*) '#MICROSTRUCTURE#'
+ ! write(6,*)
+ ! write(6,'(a,/,4(3(f10.4,1x)/))') 'rhoEdge',state(ipc,ip,el)%p(1:ns)/1e9
+ ! write(6,'(a,/,4(3(f10.4,1x)/))') 'rhoEdgeDip',state(ipc,ip,el)%p(ns+1:2*ns)/1e9
+ ! write(6,'(a,/,4(3(f10.4,1x)/))') 'Fraction',state(ipc,ip,el)%p(2*ns+1:2*ns+nt)
+ !endif
+
+end subroutine constitutive_dislotwin_microstructure
-constitutive_dislotwin_deltaState = 0.0_pReal
-end function
+!--------------------------------------------------------------------------------------------------
+!> @brief calculates plastic velocity gradient and its tangent
+!--------------------------------------------------------------------------------------------------
+subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,state,ipc,ip,el)
+ use prec, only: &
+ p_vec
+ use math, only: &
+ math_Plain3333to99, &
+ math_Mandel6to33, &
+ math_Mandel33to6, &
+ math_spectralDecompositionSym33, &
+ math_tensorproduct, &
+ math_symmetric33, &
+ math_mul33x3
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains, &
+ material_phase, &
+ phase_plasticityInstance
+ use lattice, only: &
+ lattice_Sslip, &
+ lattice_Sslip_v, &
+ lattice_Stwin, &
+ lattice_Stwin_v, &
+ lattice_maxNslipFamily,&
+ lattice_maxNtwinFamily, &
+ lattice_NslipSystem, &
+ lattice_NtwinSystem, &
+ lattice_shearTwin, &
+ lattice_fcc_corellationTwinSlip
+
+ implicit none
+ integer(pInt), intent(in) :: ipc,ip,el
+ real(pReal), intent(in) :: Temperature
+ real(pReal), dimension(6), intent(in) :: Tstar_v
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: state
+ real(pReal), dimension(3,3), intent(out) :: Lp
+ real(pReal), dimension(9,9), intent(out) :: dLp_dTstar
+
+ integer(pInt) :: matID,structID,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)))) :: &
+ gdot_slip,dgdot_dtauslip,tau_slip
+ real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
+ gdot_twin,dgdot_dtautwin,tau_twin
+ real(pReal), dimension(6) :: gdot_sb,dgdot_dtausb,tau_sb
+ real(pReal), dimension(3,3) :: eigVectors, sb_Smatrix
+ real(pReal), dimension(3) :: eigValues, sb_s, sb_m
+ real(pReal), dimension(3,6), parameter :: &
+ sb_sComposition = &
+ reshape(real([&
+ 1, 0, 1, &
+ 1, 0,-1, &
+ 1, 1, 0, &
+ 1,-1, 0, &
+ 0, 1, 1, &
+ 0, 1,-1 &
+ ],pReal),[ 3,6]), &
+ sb_mComposition = &
+ reshape(real([&
+ 1, 0,-1, &
+ 1, 0,+1, &
+ 1,-1, 0, &
+ 1, 1, 0, &
+ 0, 1,-1, &
+ 0, 1, 1 &
+ ],pReal),[ 3,6])
+ logical error
+
+ !* Shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_dislotwin_structure(matID)
+ ns = constitutive_dislotwin_totalNslip(matID)
+ nt = constitutive_dislotwin_totalNtwin(matID)
+
+ !* Total twin volume fraction
+ sumf = sum(state(ipc,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
+
+ Lp = 0.0_pReal
+ dLp_dTstar3333 = 0.0_pReal
+ dLp_dTstar = 0.0_pReal
+
+ !* Dislocation glide part
+ gdot_slip = 0.0_pReal
+ dgdot_dtauslip = 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,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Nslip(f,matID) ! 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,structID))
+
+ !* Stress ratios
+ StressRatio_p = (abs(tau_slip(j))/state(ipc,ip,el)%p(6*ns+4*nt+j))**constitutive_dislotwin_p(matID)
+ StressRatio_pminus1 = (abs(tau_slip(j))/state(ipc,ip,el)%p(6*ns+4*nt+j))**(constitutive_dislotwin_p(matID)-1.0_pReal)
+ !* Boltzmann ratio
+ BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,matID)/(kB*Temperature)
+ !* Initial shear rates
+ DotGamma0 = &
+ state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,matID)*&
+ constitutive_dislotwin_v0PerSlipSystem(j,matID)
+
+ !* Shear rates due to slip
+ gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1-StressRatio_p)**constitutive_dislotwin_q(matID))*&
+ sign(1.0_pReal,tau_slip(j))
+
+ !* Derivatives of shear rates
+ dgdot_dtauslip(j) = &
+ ((abs(gdot_slip(j))*BoltzmannRatio*&
+ constitutive_dislotwin_p(matID)*constitutive_dislotwin_q(matID))/state(ipc,ip,el)%p(6*ns+4*nt+j))*&
+ StressRatio_pminus1*(1-StressRatio_p)**(constitutive_dislotwin_q(matID)-1.0_pReal)
+
+ !* Plastic velocity gradient for dislocation glide
+ Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(:,:,1,index_myFamily+i,structID)
+
+ !* 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,structID)*&
+ lattice_Sslip(m,n,1,index_myFamily+i,structID)
+ enddo
+ enddo
+
+ !* Shear banding (shearband) part
+ if(constitutive_dislotwin_sbVelocity(matID) /= 0.0_pReal .or. &
+ constitutive_dislotwin_sbResistance(matID) /= 0.0_pReal) then
+ gdot_sb = 0.0_pReal
+ dgdot_dtausb = 0.0_pReal
+ call math_spectralDecompositionSym33(math_Mandel6to33(Tstar_v),eigValues,eigVectors, error)
+ do j = 1_pInt,6_pInt
+ sb_s = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_sComposition(1:3,j))
+ sb_m = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_mComposition(1:3,j))
+ sb_Smatrix = math_tensorproduct(sb_s,sb_m)
+ constitutive_dislotwin_sbSv(1:6,j,ipc,ip,el) = math_Mandel33to6(math_symmetric33(sb_Smatrix))
+
+ !* Calculation of Lp
+ !* Resolved shear stress on shear banding system
+ tau_sb(j) = dot_product(Tstar_v,constitutive_dislotwin_sbSv(1:6,j,ipc,ip,el))
+
+ ! if (debug_selectiveDebugger .and. ipc==debug_ipc .and. ip==debug_i .and. el==debug_e) then
+ ! write(6,'(a,3(i3,1x),a,i1,a,e10.3)') '### TAU SHEARBAND at ipc ip el ',ipc,ip,el,' on family ',j,' : ',tau
+ ! endif
+
+ !* Stress ratios
+ StressRatio_p = (abs(tau_sb(j))/constitutive_dislotwin_sbResistance(matID))**constitutive_dislotwin_p(matID)
+ StressRatio_pminus1 = (abs(tau_sb(j))/constitutive_dislotwin_sbResistance(matID))&
+ **(constitutive_dislotwin_p(matID)-1.0_pReal)
+ !* Boltzmann ratio
+ BoltzmannRatio = constitutive_dislotwin_sbQedge(matID)/(kB*Temperature)
+ !* Initial shear rates
+ DotGamma0 = constitutive_dislotwin_sbVelocity(matID)
+
+ !* Shear rates due to shearband
+ gdot_sb(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(matID))*&
+ sign(1.0_pReal,tau_sb(j))
+
+ !* Derivatives of shear rates
+ dgdot_dtausb(j) = &
+ ((abs(gdot_sb(j))*BoltzmannRatio*&
+ constitutive_dislotwin_p(matID)*constitutive_dislotwin_q(matID))/constitutive_dislotwin_sbResistance(matID))*&
+ StressRatio_pminus1*(1_pInt-StressRatio_p)**(constitutive_dislotwin_q(matID)-1.0_pReal)
+
+ !* Plastic velocity gradient for shear banding
+ Lp = Lp + gdot_sb(j)*sb_Smatrix
+
+ !* 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_dtausb(j)*&
+ sb_Smatrix(k,l)*&
+ sb_Smatrix(m,n)
+ enddo
+ end if
+
+ !* Mechanical twinning part
+ gdot_twin = 0.0_pReal
+ dgdot_dtautwin = 0.0_pReal
+ j = 0_pInt
+ do f = 1_pInt,lattice_maxNtwinFamily ! loop over all slip families
+ index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Ntwin(f,matID) ! 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,structID))
+
+ !* Stress ratios
+ StressRatio_r = (state(ipc,ip,el)%p(7*ns+4*nt+j)/tau_twin(j))**constitutive_dislotwin_r(matID)
+
+ !* Shear rates and their derivatives due to twin
+ if ( tau_twin(j) > 0.0_pReal ) then
+ select case(constitutive_dislotwin_structureName(matID))
+ case ('fcc')
+ s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i)
+ s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i)
+ if (tau_twin(j) < constitutive_dislotwin_tau_r(j,matID)) then
+ Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+&
+ abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
+ (constitutive_dislotwin_L0(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
+ (1-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
+ (constitutive_dislotwin_tau_r(j,matID)-tau_twin(j))))
+ else
+ Ndot0=0.0_pReal
+ end if
+ case default
+ Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,matID)
+ end select
+ gdot_twin(j) = &
+ (constitutive_dislotwin_MaxTwinFraction(matID)-sumf)*lattice_shearTwin(index_myFamily+i,structID)*&
+ state(ipc,ip,el)%p(7*ns+5*nt+j)*Ndot0*exp(-StressRatio_r)
+ dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_dislotwin_r(matID))/tau_twin(j))*StressRatio_r
+ endif
+
+ !* Plastic velocity gradient for mechanical twinning
+ Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,structID)
+
+ !* 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,structID)*&
+ lattice_Stwin(m,n,index_myFamily+i,structID)
+ enddo
+ enddo
+
+ dLp_dTstar = math_Plain3333to99(dLp_dTstar3333)
+
+ !if ((ip==1).and.(el==1)) then
+ ! write(6,*) '#LP/TANGENT#'
+ ! write(6,*)
+ ! write(6,*) 'Tstar_v', Tstar_v
+ ! write(6,*) 'tau_slip', tau_slip
+ ! write(6,'(a10,/,4(3(e20.8,1x),/))') 'state',state(1,1,1)%p
+ ! write(6,'(a,/,3(3(f10.4,1x)/))') 'Lp',Lp
+ ! write(6,'(a,/,9(9(f10.4,1x)/))') 'dLp_dTstar',dLp_dTstar
+ !endif
+
+end subroutine constitutive_dislotwin_LpAndItsTangent
-pure function constitutive_dislotwin_dotTemperature(Tstar_v,Temperature,state,g,ip,el)
-!*********************************************************************
-!* rate of change of microstructure *
-!* INPUT: *
-!* - Temperature : temperature *
-!* - Tstar_v : 2nd Piola Kirchhoff stress tensor (Mandel) *
-!* - ipc : component-ID at current integration point *
-!* - ip : current integration point *
-!* - el : current element *
-!* OUTPUT: *
-!* - constitutive_dotTemperature : evolution of Temperature *
-!*********************************************************************
-use prec, only: pReal,pInt,p_vec
-use mesh, only: mesh_NcpElems,mesh_maxNips
-use material, only: homogenization_maxNgrains
-implicit none
+!--------------------------------------------------------------------------------------------------
+!> @brief calculates the rate of change of microstructure
+!--------------------------------------------------------------------------------------------------
+pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,el)
+ use prec, only: p_vec
+
+ use math, only: pi
+ use mesh, only: mesh_NcpElems, mesh_maxNips
+ use material, only: homogenization_maxNgrains, material_phase, phase_plasticityInstance
+ use lattice, only: lattice_Sslip_v, lattice_Stwin_v, &
+ lattice_maxNslipFamily,lattice_maxNtwinFamily, &
+ lattice_NslipSystem, lattice_NtwinSystem, lattice_sheartwin, lattice_fcc_corellationTwinSlip
-!* Input-Output variables
-integer(pInt), intent(in) :: g,ip,el
-real(pReal), intent(in) :: Temperature
-real(pReal), dimension(6), intent(in) :: Tstar_v
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state
-real(pReal) constitutive_dislotwin_dotTemperature
+ implicit none
+ real(pReal), dimension(6), intent(in):: &
+ Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+ real(pReal), intent(in) :: &
+ temperature !< temperature at integration point
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
+ state !< microstructure state
+ real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
+ constitutive_dislotwin_dotState
-constitutive_dislotwin_dotTemperature = 0.0_pReal
-end function
-
-
-function constitutive_dislotwin_postResults(Tstar_v,Temperature,dt,state,g,ip,el)
-!*********************************************************************
-!* return array of constitutive results *
-!* INPUT: *
-!* - Temperature : temperature *
-!* - Tstar_v : 2nd Piola Kirchhoff stress tensor (Mandel) *
-!* - dt : current time increment *
-!* - ipc : component-ID at current integration point *
-!* - ip : current integration point *
-!* - el : current element *
-!*********************************************************************
-use prec, only: pReal,pInt,p_vec
-use math, only: pi,math_Mandel6to33, math_spectralDecompositionSym33
-use mesh, only: mesh_NcpElems,mesh_maxNips
-use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance,phase_Noutput
-use lattice, only: lattice_Sslip_v,lattice_Stwin_v,lattice_maxNslipFamily,lattice_maxNtwinFamily, &
- lattice_NslipSystem,lattice_NtwinSystem,lattice_shearTwin, lattice_fcc_corellationTwinSlip
-implicit none
-
-!* Definition of variables
-integer(pInt), intent(in) :: g,ip,el
-real(pReal), intent(in) :: dt,Temperature
-real(pReal), dimension(6), intent(in) :: Tstar_v
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state
-integer(pInt) myInstance,myStructure,ns,nt,f,o,i,c,j,index_myFamily,s1,s2
-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(g,ip,el)))) :: &
-gdot_slip
-real(pReal), dimension(3,3) :: eigVectors
-real(pReal), dimension (3) :: eigValues
-logical error
-real(pReal), dimension(constitutive_dislotwin_sizePostResults(phase_plasticityInstance(material_phase(g,ip,el)))) :: &
-constitutive_dislotwin_postResults
-
-!* Shortened notation
-myInstance = phase_plasticityInstance(material_phase(g,ip,el))
-myStructure = constitutive_dislotwin_structure(myInstance)
-ns = constitutive_dislotwin_totalNslip(myInstance)
-nt = constitutive_dislotwin_totalNtwin(myInstance)
-
-!* Total twin volume fraction
-sumf = sum(state(g,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
-
-!* Required output
-c = 0_pInt
-constitutive_dislotwin_postResults = 0.0_pReal
-
-!* Spectral decomposition of stress
-call math_spectralDecompositionSym33(math_Mandel6to33(Tstar_v),eigValues,eigVectors, error)
-
-do o = 1_pInt,phase_Noutput(material_phase(g,ip,el))
- select case(constitutive_dislotwin_output(o,myInstance))
-
- case ('edge_density')
- constitutive_dislotwin_postResults(c+1_pInt:c+ns) = state(g,ip,el)%p(1_pInt:ns)
- c = c + ns
- case ('dipole_density')
- constitutive_dislotwin_postResults(c+1_pInt:c+ns) = state(g,ip,el)%p(ns+1_pInt:2_pInt*ns)
- c = c + ns
- case ('shear_rate_slip')
- j = 0_pInt
- do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
- index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Nslip(f,myInstance) ! 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,myStructure))
- !* Stress ratios
- StressRatio_p = (abs(tau)/state(g,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
- constitutive_dislotwin_p(myInstance)
- StressRatio_pminus1 = (abs(tau)/state(g,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
- (constitutive_dislotwin_p(myInstance)-1.0_pReal)
- !* Boltzmann ratio
- BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,myInstance)/(kB*Temperature)
- !* Initial shear rates
- DotGamma0 = &
- state(g,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance)* &
- constitutive_dislotwin_v0PerSlipSystem(j,myInstance)
-
- !* Shear rates due to slip
- constitutive_dislotwin_postResults(c+j) = &
- DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**&
- constitutive_dislotwin_q(myInstance))*sign(1.0_pReal,tau)
- enddo ; enddo
- c = c + ns
- case ('accumulated_shear_slip')
- constitutive_dislotwin_postResults(c+1_pInt:c+ns) = &
- state(g,ip,el)%p((2_pInt*ns+1_pInt):(3_pInt*ns))
- c = c + ns
- case ('mfp_slip')
- constitutive_dislotwin_postResults(c+1_pInt:c+ns) =&
- state(g,ip,el)%p((5_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+3_pInt*nt))
- c = c + ns
- case ('resolved_stress_slip')
- j = 0_pInt
- do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
- index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Nslip(f,myInstance) ! 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,myStructure))
- enddo; enddo
- c = c + ns
- case ('threshold_stress_slip')
- constitutive_dislotwin_postResults(c+1_pInt:c+ns) = &
- state(g,ip,el)%p((6_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+4_pInt*nt))
- c = c + ns
- case ('edge_dipole_distance')
- j = 0_pInt
- do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
- index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Nslip(f,myInstance) ! process each (active) slip system in family
- j = j + 1_pInt
- constitutive_dislotwin_postResults(c+j) = &
- (3.0_pReal*constitutive_dislotwin_Gmod(myInstance)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance))/&
- (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,myStructure))))
- constitutive_dislotwin_postResults(c+j) = min(constitutive_dislotwin_postResults(c+j),state(g,ip,el)%p(5*ns+3*nt+j))
-! constitutive_dislotwin_postResults(c+j) = max(constitutive_dislotwin_postResults(c+j),state(g,ip,el)%p(4*ns+2*nt+j))
- enddo; enddo
- c = c + ns
- case ('resolved_stress_shearband')
- 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,g,ip,el))
- enddo
- c = c + 6_pInt
- case ('shear_rate_shearband')
- 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,g,ip,el))
- !* Stress ratios
- StressRatio_p = (abs(tau)/constitutive_dislotwin_sbResistance(myInstance))**constitutive_dislotwin_p(myInstance)
- StressRatio_pminus1 = (abs(tau)/constitutive_dislotwin_sbResistance(myInstance))&
- **(constitutive_dislotwin_p(myInstance)-1.0_pReal)
- !* Boltzmann ratio
- BoltzmannRatio = constitutive_dislotwin_sbQedge(myInstance)/(kB*Temperature)
- !* Initial shear rates
- DotGamma0 = constitutive_dislotwin_sbVelocity(myInstance)
-
- !* Shear rates due to slip
- constitutive_dislotwin_postResults(c+j) = &
- DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(myInstance))*sign(1.0_pReal,tau)
- enddo
- c = c + 6_pInt
- case ('twin_fraction')
- constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(g,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))
- c = c + nt
- case ('shear_rate_twin')
- if (nt > 0_pInt) then
+ integer(pInt) matID,structID,ns,nt,f,i,j,index_myFamily,s1,s2
+ 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)))) :: &
+ gdot_slip,tau_slip,DotRhoMultiplication,EdgeDipDistance,DotRhoEdgeEdgeAnnihilation,DotRhoEdgeDipAnnihilation,&
+ ClimbVelocity,DotRhoEdgeDipClimb,DotRhoDipFormation
+ real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
+ tau_twin
+
+ !* Shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_dislotwin_structure(matID)
+ ns = constitutive_dislotwin_totalNslip(matID)
+ nt = constitutive_dislotwin_totalNtwin(matID)
+
+ !* Total twin volume fraction
+ sumf = sum(state(ipc,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
+
+ constitutive_dislotwin_dotState = 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,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Nslip(f,matID) ! 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,structID))
+ !* Stress ratios
+ StressRatio_p = (abs(tau_slip(j))/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
+ constitutive_dislotwin_p(matID)
+ StressRatio_pminus1 = (abs(tau_slip(j))/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
+ (constitutive_dislotwin_p(matID)-1.0_pReal)
+ !* Boltzmann ratio
+ BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,matID)/(kB*Temperature)
+ !* Initial shear rates
+ DotGamma0 = &
+ state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,matID)*&
+ constitutive_dislotwin_v0PerSlipSystem(j,matID)
+
+ !* Shear rates due to slip
+ gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(matID))*&
+ sign(1.0_pReal,tau_slip(j))
+
+ !* Multiplication
+ DotRhoMultiplication(j) = abs(gdot_slip(j))/&
+ (constitutive_dislotwin_burgersPerSlipSystem(j,matID)*state(ipc,ip,el)%p(5*ns+3*nt+j))
+
+ !* Dipole formation
+ EdgeDipMinDistance = &
+ constitutive_dislotwin_CEdgeDipMinDistance(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID)
+ if (tau_slip(j) == 0.0_pReal) then
+ DotRhoDipFormation(j) = 0.0_pReal
+ else
+ EdgeDipDistance(j) = &
+ (3.0_pReal*constitutive_dislotwin_Gmod(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))/&
+ (16.0_pReal*pi*abs(tau_slip(j)))
+ if (EdgeDipDistance(j)>state(ipc,ip,el)%p(5*ns+3*nt+j)) EdgeDipDistance(j)=state(ipc,ip,el)%p(5*ns+3*nt+j)
+ if (EdgeDipDistance(j) 0.0_pReal ) then
+ select case(constitutive_dislotwin_structureName(matID))
+ case ('fcc')
+ s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i)
+ s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i)
+ if (tau_twin(j) < constitutive_dislotwin_tau_r(j,matID)) then
+ Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+&
+ abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
+ (constitutive_dislotwin_L0(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
+ (1-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
+ (constitutive_dislotwin_tau_r(j,matID)-tau_twin(j))))
+ else
+ Ndot0=0.0_pReal
+ end if
+ case default
+ Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,matID)
+ end select
+ constitutive_dislotwin_dotState(3_pInt*ns+j) = &
+ (constitutive_dislotwin_MaxTwinFraction(matID)-sumf)*&
+ state(ipc,ip,el)%p(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r)
- j = 0_pInt
- do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
- index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Nslip(f,myInstance) ! process each (active) slip system in family
- j = j + 1_pInt
+ !* 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,structID)
+
+ endif
+
+ enddo
+ enddo
+
+ !write(6,*) '#DOTSTATE#'
+ !write(6,*)
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'tau slip',tau_slip
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'gamma slip',gdot_slip
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'RhoEdge',state(ipc,ip,el)%p(1:ns)
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'Threshold Slip', state(ipc,ip,el)%p(5*ns+3*nt+1:6*ns+3*nt)
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'Multiplication',DotRhoMultiplication
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'DipFormation',DotRhoDipFormation
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'SingleSingle',DotRhoEdgeEdgeAnnihilation
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'SingleDipole',DotRhoEdgeDipAnnihilation
+ !write(6,'(a,/,4(3(f30.20,1x)/))') 'DipClimb',DotRhoEdgeDipClimb
+
+end function constitutive_dislotwin_dotState
+
+!--------------------------------------------------------------------------------------------------
+!> @brief (instantaneous) incremental change of microstructure
+!> @details dummy function, returns 0.0
+!--------------------------------------------------------------------------------------------------
+pure function constitutive_dislotwin_deltaState(Tstar_v,temperature,state,ipc,ip,el)
+ use prec, only: &
+ p_vec
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains, &
+ material_phase, &
+ phase_plasticityInstance
+
+ implicit none
+ real(pReal), dimension(6), intent(in):: &
+ Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+ real(pReal), intent(in) :: &
+ Temperature !< temperature at integration point
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
+ state !< microstructure state
+
+ real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
+ constitutive_dislotwin_deltaState
+
+ constitutive_dislotwin_deltaState = 0.0_pReal
+
+end function constitutive_dislotwin_deltaState
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief calculates the rate of change of temperature
+!> @details dummy function, returns 0.0
+!--------------------------------------------------------------------------------------------------
+real(pReal) pure function constitutive_dislotwin_dotTemperature(Tstar_v,temperature,state,ipc,ip,el)
+ use prec, only: &
+ p_vec
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains
+
+ implicit none
+ real(pReal), dimension(6), intent(in) :: &
+ Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+ real(pReal), intent(in) :: &
+ temperature !< temperature at integration point
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
+ state !< microstructure state
+
+ constitutive_dislotwin_dotTemperature = 0.0_pReal
+
+end function constitutive_dislotwin_dotTemperature
+
+!--------------------------------------------------------------------------------------------------
+!> @brief return array of constitutive results
+!--------------------------------------------------------------------------------------------------
+function constitutive_dislotwin_postResults(Tstar_v,Temperature,dt,state,ipc,ip,el)
+ use prec, only: &
+ p_vec
+ use math, only: &
+ pi, &
+ math_Mandel6to33, &
+ math_spectralDecompositionSym33
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains,&
+ material_phase, &
+ phase_plasticityInstance,&
+ phase_Noutput
+ use lattice, only: &
+ lattice_Sslip_v, &
+ lattice_Stwin_v, &
+ lattice_maxNslipFamily, &
+ lattice_maxNtwinFamily, &
+ lattice_NslipSystem, &
+ lattice_NtwinSystem, &
+ lattice_shearTwin, &
+ lattice_fcc_corellationTwinSlip
+
+ implicit none
+ real(pReal), dimension(6), intent(in) :: &
+ Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+ real(pReal), intent(in) :: &
+ temperature, & !< temperature at integration point
+ dt
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
+ state !< microstructure state
+
+ real(pReal), dimension(constitutive_dislotwin_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
+ constitutive_dislotwin_postResults
+
+ integer(pInt) :: &
+ matID,structID,&
+ ns,nt,&
+ f,o,i,c,j,index_myFamily,&
+ s1,s2
+ 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
+
+ !* Shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_dislotwin_structure(matID)
+ ns = constitutive_dislotwin_totalNslip(matID)
+ nt = constitutive_dislotwin_totalNtwin(matID)
+
+ !* Total twin volume fraction
+ sumf = sum(state(ipc,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0
+
+ !* Required output
+ c = 0_pInt
+ constitutive_dislotwin_postResults = 0.0_pReal
+
+ !* Spectral decomposition of stress
+ call math_spectralDecompositionSym33(math_Mandel6to33(Tstar_v),eigValues,eigVectors, error)
+
+ do o = 1_pInt,phase_Noutput(material_phase(ipc,ip,el))
+ select case(constitutive_dislotwin_output(o,matID))
+
+ case ('edge_density')
+ constitutive_dislotwin_postResults(c+1_pInt:c+ns) = state(ipc,ip,el)%p(1_pInt:ns)
+ c = c + ns
+ case ('dipole_density')
+ constitutive_dislotwin_postResults(c+1_pInt:c+ns) = state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)
+ c = c + ns
+ case ('shear_rate_slip')
+ j = 0_pInt
+ do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
+ index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Nslip(f,matID) ! 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,myStructure))
+ tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID))
!* Stress ratios
- StressRatio_p = (abs(tau)/state(g,ip,el)%p(5_pInt*ns+3_pInt*nt+j))**&
- constitutive_dislotwin_p(myInstance)
- StressRatio_pminus1 = (abs(tau)/state(g,ip,el)%p(5_pInt*ns+3_pInt*nt+j))**&
- (constitutive_dislotwin_p(myInstance)-1.0_pReal)
+ StressRatio_p = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
+ constitutive_dislotwin_p(matID)
+ StressRatio_pminus1 = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
+ (constitutive_dislotwin_p(matID)-1.0_pReal)
!* Boltzmann ratio
- BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,myInstance)/(kB*Temperature)
+ BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,matID)/(kB*Temperature)
!* Initial shear rates
DotGamma0 = &
- state(g,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance)* &
- constitutive_dislotwin_v0PerSlipSystem(j,myInstance)
-
+ state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,matID)* &
+ constitutive_dislotwin_v0PerSlipSystem(j,matID)
+
+ !* Shear rates due to slip
+ constitutive_dislotwin_postResults(c+j) = &
+ DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**&
+ constitutive_dislotwin_q(matID))*sign(1.0_pReal,tau)
+ enddo ; enddo
+ c = c + ns
+ case ('accumulated_shear_slip')
+ constitutive_dislotwin_postResults(c+1_pInt:c+ns) = &
+ state(ipc,ip,el)%p((2_pInt*ns+1_pInt):(3_pInt*ns))
+ c = c + ns
+ case ('mfp_slip')
+ constitutive_dislotwin_postResults(c+1_pInt:c+ns) =&
+ state(ipc,ip,el)%p((5_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+3_pInt*nt))
+ c = c + ns
+ case ('resolved_stress_slip')
+ j = 0_pInt
+ do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
+ index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Nslip(f,matID) ! 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,structID))
+ enddo; enddo
+ c = c + ns
+ case ('threshold_stress_slip')
+ constitutive_dislotwin_postResults(c+1_pInt:c+ns) = &
+ state(ipc,ip,el)%p((6_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+4_pInt*nt))
+ c = c + ns
+ case ('edge_dipole_distance')
+ j = 0_pInt
+ do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
+ index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Nslip(f,matID) ! process each (active) slip system in family
+ j = j + 1_pInt
+ constitutive_dislotwin_postResults(c+j) = &
+ (3.0_pReal*constitutive_dislotwin_Gmod(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))/&
+ (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID))))
+ constitutive_dislotwin_postResults(c+j) = min(constitutive_dislotwin_postResults(c+j),state(ipc,ip,el)%p(5*ns+3*nt+j))
+ ! constitutive_dislotwin_postResults(c+j) = max(constitutive_dislotwin_postResults(c+j),state(ipc,ip,el)%p(4*ns+2*nt+j))
+ enddo; enddo
+ c = c + ns
+ case ('resolved_stress_shearband')
+ 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')
+ 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
+ StressRatio_p = (abs(tau)/constitutive_dislotwin_sbResistance(matID))**constitutive_dislotwin_p(matID)
+ StressRatio_pminus1 = (abs(tau)/constitutive_dislotwin_sbResistance(matID))&
+ **(constitutive_dislotwin_p(matID)-1.0_pReal)
+ !* Boltzmann ratio
+ BoltzmannRatio = constitutive_dislotwin_sbQedge(matID)/(kB*Temperature)
+ !* Initial shear rates
+ DotGamma0 = constitutive_dislotwin_sbVelocity(matID)
+
+ !* Shear rates due to slip
+ constitutive_dislotwin_postResults(c+j) = &
+ DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(matID))*sign(1.0_pReal,tau)
+ enddo
+ c = c + 6_pInt
+ case ('twin_fraction')
+ constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(ipc,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))
+ c = c + nt
+ case ('shear_rate_twin')
+ 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,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Nslip(f,matID) ! 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,structID))
+ !* Stress ratios
+ StressRatio_p = (abs(tau)/state(ipc,ip,el)%p(5_pInt*ns+3_pInt*nt+j))**&
+ constitutive_dislotwin_p(matID)
+ StressRatio_pminus1 = (abs(tau)/state(ipc,ip,el)%p(5_pInt*ns+3_pInt*nt+j))**&
+ (constitutive_dislotwin_p(matID)-1.0_pReal)
+ !* Boltzmann ratio
+ BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,matID)/(kB*Temperature)
+ !* Initial shear rates
+ DotGamma0 = &
+ state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,matID)* &
+ constitutive_dislotwin_v0PerSlipSystem(j,matID)
+
+ !* Shear rates due to slip
+ gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**&
+ constitutive_dislotwin_q(matID))*sign(1.0_pReal,tau)
+ 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,structID)) ! at which index starts my family
+ do i = 1,constitutive_dislotwin_Ntwin(f,matID) ! 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,structID))
+ !* Stress ratios
+ StressRatio_r = (state(ipc,ip,el)%p(7_pInt*ns+4_pInt*nt+j)/tau)**constitutive_dislotwin_r(matID)
+
+ !* Shear rates due to twin
+ if ( tau > 0.0_pReal ) then
+ select case(constitutive_dislotwin_structureName(matID))
+ case ('fcc')
+ s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i)
+ s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i)
+ if (tau < constitutive_dislotwin_tau_r(j,matID)) then
+ Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+&
+ abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
+ (constitutive_dislotwin_L0(matID)*&
+ constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
+ (1-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
+ (constitutive_dislotwin_tau_r(j,matID)-tau)))
+ else
+ Ndot0=0.0_pReal
+ end if
+ case default
+ Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,matID)
+ end select
+ constitutive_dislotwin_postResults(c+j) = &
+ (constitutive_dislotwin_MaxTwinFraction(matID)-sumf)*lattice_shearTwin(index_myFamily+i,structID)*&
+ state(ipc,ip,el)%p(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r)
+ endif
+
+ enddo ; enddo
+ endif
+ c = c + nt
+ case ('accumulated_shear_twin')
+ constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(ipc,ip,el)%p((3_pInt*ns+nt+1_pInt):(3_pInt*ns+2_pInt*nt))
+ c = c + nt
+ case ('mfp_twin')
+ constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(ipc,ip,el)%p((6_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+4_pInt*nt))
+ c = c + nt
+ case ('resolved_stress_twin')
+ 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,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Ntwin(f,matID) ! 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,structID))
+ enddo; enddo
+ endif
+ c = c + nt
+ case ('threshold_stress_twin')
+ constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(ipc,ip,el)%p((7_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+5_pInt*nt))
+ c = c + nt
+ case ('stress_exponent')
+ j = 0_pInt
+ do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
+ index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_dislotwin_Nslip(f,matID) ! 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,structID))
+ !* Stress ratios
+ StressRatio_p = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
+ constitutive_dislotwin_p(matID)
+ StressRatio_pminus1 = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
+ (constitutive_dislotwin_p(matID)-1.0_pReal)
+ !* Boltzmann ratio
+ BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,matID)/(kB*Temperature)
+ !* Initial shear rates
+ DotGamma0 = &
+ state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,matID)* &
+ constitutive_dislotwin_v0PerSlipSystem(j,matID)
+
!* Shear rates due to slip
gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**&
- constitutive_dislotwin_q(myInstance))*sign(1.0_pReal,tau)
- 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,myStructure)) ! at which index starts my family
- do i = 1,constitutive_dislotwin_Ntwin(f,myInstance) ! process each (active) twin system in family
- j = j + 1_pInt
+ constitutive_dislotwin_q(matID))*sign(1.0_pReal,tau)
+
+ !* Derivatives of shear rates
+ dgdot_dtauslip = &
+ ((abs(gdot_slip(j))*BoltzmannRatio*&
+ constitutive_dislotwin_p(matID)*constitutive_dislotwin_q(matID))/state(ipc,ip,el)%p(6*ns+4*nt+j))*&
+ StressRatio_pminus1*(1_pInt-StressRatio_p)**(constitutive_dislotwin_q(matID)-1.0_pReal)
+
+ !* Stress exponent
+ if (gdot_slip(j)==0.0_pReal) then
+ constitutive_dislotwin_postResults(c+j) = 0.0_pReal
+ else
+ constitutive_dislotwin_postResults(c+j) = (tau/gdot_slip(j))*dgdot_dtauslip
+ endif
+ enddo ; enddo
+ c = c + ns
+ case ('sb_eigenvalues')
+ forall (j = 1_pInt:3_pInt) &
+ constitutive_dislotwin_postResults(c+j) = eigValues(j)
+ c = c + 3_pInt
+ case ('sb_eigenvectors')
+ constitutive_dislotwin_postResults(c+1_pInt:c+9_pInt) = reshape(eigVectors,(/9/))
+ c = c + 9_pInt
+ end select
+ enddo
+end function constitutive_dislotwin_postResults
- !* Resolved shear stress on twin system
- tau = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,myStructure))
- !* Stress ratios
- StressRatio_r = (state(g,ip,el)%p(7_pInt*ns+4_pInt*nt+j)/tau)**constitutive_dislotwin_r(myInstance)
-
- !* Shear rates due to twin
- if ( tau > 0.0_pReal ) then
- select case(constitutive_dislotwin_structureName(myInstance))
- case ('fcc')
- s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i)
- s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i)
- if (tau < constitutive_dislotwin_tau_r(j,myInstance)) then
- Ndot0=(abs(gdot_slip(s1))*(state(g,ip,el)%p(s2)+state(g,ip,el)%p(ns+s2))+&
- abs(gdot_slip(s2))*(state(g,ip,el)%p(s1)+state(g,ip,el)%p(ns+s1)))/&
- (constitutive_dislotwin_L0(myInstance)*&
- constitutive_dislotwin_burgersPerSlipSystem(j,myInstance))*&
- (1-exp(-constitutive_dislotwin_VcrossSlip(myInstance)/(kB*Temperature)*&
- (constitutive_dislotwin_tau_r(j,myInstance)-tau)))
- else
- Ndot0=0.0_pReal
- end if
- case default
- Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,myInstance)
- end select
- constitutive_dislotwin_postResults(c+j) = &
- (constitutive_dislotwin_MaxTwinFraction(myInstance)-sumf)*lattice_shearTwin(index_myFamily+i,myStructure)*&
- state(g,ip,el)%p(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r)
- endif
-
- enddo ; enddo
- endif
- c = c + nt
- case ('accumulated_shear_twin')
- constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(g,ip,el)%p((3_pInt*ns+nt+1_pInt):(3_pInt*ns+2_pInt*nt))
- c = c + nt
- case ('mfp_twin')
- constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(g,ip,el)%p((6_pInt*ns+3_pInt*nt+1_pInt):(6_pInt*ns+4_pInt*nt))
- c = c + nt
- case ('resolved_stress_twin')
- 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,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Ntwin(f,myInstance) ! 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,myStructure))
- enddo; enddo
- endif
- c = c + nt
- case ('threshold_stress_twin')
- constitutive_dislotwin_postResults(c+1_pInt:c+nt) = state(g,ip,el)%p((7_pInt*ns+4_pInt*nt+1_pInt):(7_pInt*ns+5_pInt*nt))
- c = c + nt
- case ('stress_exponent')
- j = 0_pInt
- do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families
- index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_dislotwin_Nslip(f,myInstance) ! 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,myStructure))
- !* Stress ratios
- StressRatio_p = (abs(tau)/state(g,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
- constitutive_dislotwin_p(myInstance)
- StressRatio_pminus1 = (abs(tau)/state(g,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**&
- (constitutive_dislotwin_p(myInstance)-1.0_pReal)
- !* Boltzmann ratio
- BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,myInstance)/(kB*Temperature)
- !* Initial shear rates
- DotGamma0 = &
- state(g,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,myInstance)* &
- constitutive_dislotwin_v0PerSlipSystem(j,myInstance)
-
- !* Shear rates due to slip
- gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**&
- constitutive_dislotwin_q(myInstance))*sign(1.0_pReal,tau)
-
- !* Derivatives of shear rates
- dgdot_dtauslip = &
- ((abs(gdot_slip(j))*BoltzmannRatio*&
- constitutive_dislotwin_p(myInstance)*constitutive_dislotwin_q(myInstance))/state(g,ip,el)%p(6*ns+4*nt+j))*&
- StressRatio_pminus1*(1_pInt-StressRatio_p)**(constitutive_dislotwin_q(myInstance)-1.0_pReal)
-
- !* Stress exponent
- if (gdot_slip(j)==0.0_pReal) then
- constitutive_dislotwin_postResults(c+j) = 0.0_pReal
- else
- constitutive_dislotwin_postResults(c+j) = (tau/gdot_slip(j))*dgdot_dtauslip
- endif
- enddo ; enddo
- c = c + ns
- case ('sb_eigenvalues')
- forall (j = 1_pInt:3_pInt) &
- constitutive_dislotwin_postResults(c+j) = eigValues(j)
- c = c + 3_pInt
- case ('sb_eigenvectors')
- constitutive_dislotwin_postResults(c+1_pInt:c+9_pInt) = reshape(eigVectors,(/9/))
- c = c + 9_pInt
- end select
-enddo
-
-end function
-
-END MODULE
+end module constitutive_dislotwin
diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90
index a89b4e4f6..0a733bb4c 100644
--- a/code/constitutive_j2.f90
+++ b/code/constitutive_j2.f90
@@ -36,10 +36,10 @@ module constitutive_j2
character (len=*), parameter, public :: &
CONSTITUTIVE_J2_label = 'j2' !< label for this constitutive model
- integer(pInt), dimension(:), allocatable, public :: &
- constitutive_j2_sizeDotState, &
- constitutive_j2_sizeState, &
- constitutive_j2_sizePostResults
+ integer(pInt), dimension(:), allocatable, public, protected :: &
+ constitutive_j2_sizeDotState, & !< number of dotStates
+ constitutive_j2_sizeState, & !< total number of microstructural variables
+ constitutive_j2_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
constitutive_j2_sizePostResult !< size of each post result output
@@ -48,10 +48,10 @@ module constitutive_j2
constitutive_j2_output !< name of each post result output
character(len=32), dimension(:), allocatable, private :: &
- constitutive_j2_structureName
+ constitutive_j2_structureName !< name of the lattice structure
integer(pInt), dimension(:), allocatable, private :: &
- constitutive_j2_Noutput !< ??
+ constitutive_j2_Noutput !< number of outputs per instance
real(pReal), dimension(:), allocatable, private :: &
constitutive_j2_fTaylor, & !< Taylor factor
@@ -313,13 +313,13 @@ end subroutine constitutive_j2_init
!> @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
!--------------------------------------------------------------------------------------------------
-pure function constitutive_j2_stateInit(myInstance)
+pure function constitutive_j2_stateInit(matID)
implicit none
real(pReal), dimension(1) :: constitutive_j2_stateInit
- integer(pInt), intent(in) :: myInstance !< number specifying the instance of the plasticity
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
- constitutive_j2_stateInit = constitutive_j2_tau0(myInstance)
+ constitutive_j2_stateInit = constitutive_j2_tau0(matID)
end function constitutive_j2_stateInit
@@ -327,15 +327,15 @@ end function constitutive_j2_stateInit
!--------------------------------------------------------------------------------------------------
!> @brief sets the relevant state values for a given instance of this plasticity
!--------------------------------------------------------------------------------------------------
-pure function constitutive_j2_aTolState(myInstance)
+pure function constitutive_j2_aTolState(matID)
implicit none
- integer(pInt), intent(in) :: myInstance !< number specifying the instance of the plasticity
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
- real(pReal), dimension(constitutive_j2_sizeState(myInstance)) :: &
+ real(pReal), dimension(constitutive_j2_sizeState(matID)) :: &
constitutive_j2_aTolState
- constitutive_j2_aTolState = constitutive_j2_aTolResistance(myInstance)
+ constitutive_j2_aTolState = constitutive_j2_aTolResistance(matID)
end function constitutive_j2_aTolState
diff --git a/code/constitutive_none.f90 b/code/constitutive_none.f90
index b0c431b29..6afd05325 100644
--- a/code/constitutive_none.f90
+++ b/code/constitutive_none.f90
@@ -33,7 +33,7 @@ module constitutive_none
character (len=*), parameter, public :: &
CONSTITUTIVE_NONE_label = 'none' !< label for this constitutive model
- integer(pInt), dimension(:), allocatable, public :: &
+ integer(pInt), dimension(:), allocatable, public, protected :: &
constitutive_none_sizeDotState, &
constitutive_none_sizeState, &
constitutive_none_sizePostResults
@@ -193,11 +193,11 @@ end subroutine constitutive_none_init
!> @brief sets the initial microstructural state for a given instance of this plasticity
!> @details dummy function, returns 0.0
!--------------------------------------------------------------------------------------------------
-pure function constitutive_none_stateInit(myInstance)
+pure function constitutive_none_stateInit(matID)
implicit none
real(pReal), dimension(1) :: constitutive_none_stateInit
- integer(pInt), intent(in) :: myInstance !< number specifying the instance of the plasticity
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
constitutive_none_stateInit = 0.0_pReal
@@ -208,12 +208,12 @@ end function constitutive_none_stateInit
!> @brief sets the relevant state values for a given instance of this plasticity
!> @details ensures convergence as state is always 0.0
!--------------------------------------------------------------------------------------------------
-pure function constitutive_none_aTolState(myInstance)
+pure function constitutive_none_aTolState(matID)
implicit none
- integer(pInt), intent(in) :: myInstance !< number specifying the instance of the plasticity
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
- real(pReal), dimension(constitutive_none_sizeState(myInstance)) :: &
+ real(pReal), dimension(constitutive_none_sizeState(matID)) :: &
constitutive_none_aTolState
constitutive_none_aTolState = 1.0_pReal
diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90
index 1cfd6582f..86bc1e976 100644
--- a/code/constitutive_nonlocal.f90
+++ b/code/constitutive_nonlocal.f90
@@ -76,7 +76,7 @@ KB = 1.38e-23_pReal !< Physical
!* Definition of global variables
-integer(pInt), dimension(:), allocatable, public :: &
+integer(pInt), dimension(:), allocatable, public, protected :: &
constitutive_nonlocal_sizeDotState, & !< number of dotStates = number of basic state variables
constitutive_nonlocal_sizeDependentState, & !< number of dependent state variables
constitutive_nonlocal_sizeState, & !< total number of state variables
diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90
index 96db64048..03a916ca7 100644
--- a/code/constitutive_phenopowerlaw.f90
+++ b/code/constitutive_phenopowerlaw.f90
@@ -34,7 +34,7 @@ module constitutive_phenopowerlaw
character (len=*), parameter, public :: &
CONSTITUTIVE_PHENOPOWERLAW_label = 'phenopowerlaw'
- integer(pInt), dimension(:), allocatable, public :: &
+ integer(pInt), dimension(:), allocatable, public, protected :: &
constitutive_phenopowerlaw_sizeDotState, &
constitutive_phenopowerlaw_sizeState, &
constitutive_phenopowerlaw_sizePostResults, & !< cumulative size of post results
@@ -142,7 +142,7 @@ subroutine constitutive_phenopowerlaw_init(myFile)
i,j,k, f,o, &
Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, &
Nchunks_SlipFamilies, Nchunks_TwinFamilies, Nchunks_nonSchmid, &
- myStructure, index_myFamily, index_otherFamily, &
+ structID, index_myFamily, index_otherFamily, &
mySize=0_pInt, section = 0_pInt
character(len=65536) :: &
tag = '', &
@@ -419,14 +419,15 @@ subroutine constitutive_phenopowerlaw_init(myFile)
enddo
sanityChecks: do i = 1_pInt,maxNinstance
- constitutive_phenopowerlaw_structure(i) = lattice_initializeStructure(constitutive_phenopowerlaw_structureName(i), & ! get structure
- constitutive_phenopowerlaw_CoverA(i))
+ constitutive_phenopowerlaw_structure(i) = &
+ lattice_initializeStructure(constitutive_phenopowerlaw_structureName(i), constitutive_phenopowerlaw_CoverA(i)) ! get structure
+
constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,i) = &
- min(lattice_NslipSystem(1:lattice_maxNslipFamily,constitutive_phenopowerlaw_structure(i)),& ! limit active slip systems per family to min of available and requested
- constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,i))
+ min(lattice_NslipSystem(1:lattice_maxNslipFamily,constitutive_phenopowerlaw_structure(i)),& ! limit active slip systems per family to min of available and requested
+ constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,i))
constitutive_phenopowerlaw_Ntwin(1:lattice_maxNtwinFamily,i) = &
- min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,constitutive_phenopowerlaw_structure(i)),& ! limit active twin systems per family to min of available and requested
- constitutive_phenopowerlaw_Ntwin(:,i))
+ min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,constitutive_phenopowerlaw_structure(i)),& ! limit active twin systems per family to min of available and requested
+ constitutive_phenopowerlaw_Ntwin(:,i))
constitutive_phenopowerlaw_totalNslip(i) = sum(constitutive_phenopowerlaw_Nslip(:,i)) ! how many slip systems altogether
constitutive_phenopowerlaw_totalNtwin(i) = sum(constitutive_phenopowerlaw_Ntwin(:,i)) ! how many twin systems altogether
@@ -504,11 +505,10 @@ subroutine constitutive_phenopowerlaw_init(myFile)
call IO_error(212_pInt,ext_msg=constitutive_phenopowerlaw_output(o,i)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')')
end select
- if (mySize > 0_pInt) then ! any meaningful output found
+ outputFound: if (mySize > 0_pInt) then
constitutive_phenopowerlaw_sizePostResult(o,i) = mySize
- constitutive_phenopowerlaw_sizePostResults(i) = &
- constitutive_phenopowerlaw_sizePostResults(i) + mySize
- endif
+ constitutive_phenopowerlaw_sizePostResults(i) = constitutive_phenopowerlaw_sizePostResults(i) + mySize
+ endif outputFound
enddo outputsLoop
constitutive_phenopowerlaw_sizeDotState(i) = constitutive_phenopowerlaw_totalNslip(i)+ &
@@ -518,11 +518,12 @@ subroutine constitutive_phenopowerlaw_init(myFile)
constitutive_phenopowerlaw_totalNtwin(i) ! s_slip, s_twin, sum(gamma), sum(f), accshear_slip, accshear_twin
constitutive_phenopowerlaw_sizeState(i) = constitutive_phenopowerlaw_sizeDotState(i)
- myStructure = constitutive_phenopowerlaw_structure(i)
+ structID = constitutive_phenopowerlaw_structure(i)
- constitutive_phenopowerlaw_Cslip_66(:,:,i) = lattice_symmetrizeC66(constitutive_phenopowerlaw_structureName(i),&
- constitutive_phenopowerlaw_Cslip_66(:,:,i))
- ! assign elasticity tensor
+ constitutive_phenopowerlaw_Cslip_66(:,:,i) = &
+ lattice_symmetrizeC66(constitutive_phenopowerlaw_structureName(i),&
+ constitutive_phenopowerlaw_Cslip_66(:,:,i)) ! assign elasticity tensor
+
constitutive_phenopowerlaw_Cslip_66(:,:,i) = &
math_Mandel3333to66(math_Voigt66to3333(constitutive_phenopowerlaw_Cslip_66(:,:,i)))
@@ -534,9 +535,9 @@ subroutine constitutive_phenopowerlaw_init(myFile)
do k = 1_pInt,constitutive_phenopowerlaw_Nslip(o,i) ! loop over (active) systems in other family (slip)
constitutive_phenopowerlaw_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,i) = &
constitutive_phenopowerlaw_interaction_SlipSlip(lattice_interactionSlipSlip( &
- sum(lattice_NslipSystem(1:f-1,myStructure))+j, &
- sum(lattice_NslipSystem(1:o-1,myStructure))+k, &
- myStructure), i )
+ sum(lattice_NslipSystem(1:f-1,structID))+j, &
+ sum(lattice_NslipSystem(1:o-1,structID))+k, &
+ structID), i )
enddo; enddo
do o = 1_pInt,lattice_maxNtwinFamily
@@ -544,9 +545,9 @@ subroutine constitutive_phenopowerlaw_init(myFile)
do k = 1_pInt,constitutive_phenopowerlaw_Ntwin(o,i) ! loop over (active) systems in other family (twin)
constitutive_phenopowerlaw_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,i) = &
constitutive_phenopowerlaw_interaction_SlipTwin(lattice_interactionSlipTwin( &
- sum(lattice_NslipSystem(1:f-1_pInt,myStructure))+j, &
- sum(lattice_NtwinSystem(1:o-1_pInt,myStructure))+k, &
- myStructure), i )
+ sum(lattice_NslipSystem(1:f-1_pInt,structID))+j, &
+ sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, &
+ structID), i )
enddo; enddo
enddo; enddo
@@ -560,9 +561,9 @@ subroutine constitutive_phenopowerlaw_init(myFile)
do k = 1_pInt,constitutive_phenopowerlaw_Nslip(o,i) ! loop over (active) systems in other family (slip)
constitutive_phenopowerlaw_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,i) = &
constitutive_phenopowerlaw_interaction_TwinSlip(lattice_interactionTwinSlip( &
- sum(lattice_NtwinSystem(1:f-1_pInt,myStructure))+j, &
- sum(lattice_NslipSystem(1:o-1_pInt,myStructure))+k, &
- myStructure), i )
+ sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, &
+ sum(lattice_NslipSystem(1:o-1_pInt,structID))+k, &
+ structID), i )
enddo; enddo
do o = 1_pInt,lattice_maxNtwinFamily
@@ -570,9 +571,9 @@ subroutine constitutive_phenopowerlaw_init(myFile)
do k = 1_pInt,constitutive_phenopowerlaw_Ntwin(o,i) ! loop over (active) systems in other family (twin)
constitutive_phenopowerlaw_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,i) = &
constitutive_phenopowerlaw_interaction_TwinTwin(lattice_interactionTwinTwin( &
- sum(lattice_NtwinSystem(1:f-1_pInt,myStructure))+j, &
- sum(lattice_NtwinSystem(1:o-1_pInt,myStructure))+k, &
- myStructure), i )
+ sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, &
+ sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, &
+ structID), i )
enddo; enddo
enddo; enddo
@@ -585,15 +586,15 @@ end subroutine constitutive_phenopowerlaw_init
!--------------------------------------------------------------------------------------------------
!> @brief sets the initial microstructural state for a given instance of this plasticity
!--------------------------------------------------------------------------------------------------
-pure function constitutive_phenopowerlaw_stateInit(myInstance)
+pure function constitutive_phenopowerlaw_stateInit(matID)
use lattice, only: &
lattice_maxNslipFamily, &
lattice_maxNtwinFamily
implicit none
integer(pInt), intent(in) :: &
- myInstance !< number specifying the instance of the plasticity
- real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(myInstance)) :: &
+ matID !< number specifying the instance of the plasticity
+ real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(matID)) :: &
constitutive_phenopowerlaw_stateInit
integer(pInt) :: &
i
@@ -602,17 +603,17 @@ pure function constitutive_phenopowerlaw_stateInit(myInstance)
do i = 1_pInt,lattice_maxNslipFamily
constitutive_phenopowerlaw_stateInit(1+&
- sum(constitutive_phenopowerlaw_Nslip(1:i-1,myInstance)) : &
- sum(constitutive_phenopowerlaw_Nslip(1:i ,myInstance))) = &
- constitutive_phenopowerlaw_tau0_slip(i,myInstance)
+ sum(constitutive_phenopowerlaw_Nslip(1:i-1,matID)) : &
+ sum(constitutive_phenopowerlaw_Nslip(1:i ,matID))) = &
+ constitutive_phenopowerlaw_tau0_slip(i,matID)
enddo
do i = 1_pInt,lattice_maxNtwinFamily
- constitutive_phenopowerlaw_stateInit(1+sum(constitutive_phenopowerlaw_Nslip(:,myInstance))+&
- sum(constitutive_phenopowerlaw_Ntwin(1:i-1,myInstance)) : &
- sum(constitutive_phenopowerlaw_Nslip(:,myInstance))+&
- sum(constitutive_phenopowerlaw_Ntwin(1:i ,myInstance))) = &
- constitutive_phenopowerlaw_tau0_twin(i,myInstance)
+ constitutive_phenopowerlaw_stateInit(1+sum(constitutive_phenopowerlaw_Nslip(:,matID))+&
+ sum(constitutive_phenopowerlaw_Ntwin(1:i-1,matID)) : &
+ sum(constitutive_phenopowerlaw_Nslip(:,matID))+&
+ sum(constitutive_phenopowerlaw_Ntwin(1:i ,matID))) = &
+ constitutive_phenopowerlaw_tau0_twin(i,matID)
enddo
end function constitutive_phenopowerlaw_stateInit
@@ -621,28 +622,28 @@ end function constitutive_phenopowerlaw_stateInit
!--------------------------------------------------------------------------------------------------
!> @brief sets the relevant state values for a given instance of this plasticity
!--------------------------------------------------------------------------------------------------
-pure function constitutive_phenopowerlaw_aTolState(myInstance)
+pure function constitutive_phenopowerlaw_aTolState(matID)
implicit none
- integer(pInt), intent(in) :: myInstance !< number specifying the instance of the plasticity
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
-real(pReal), dimension(constitutive_phenopowerlaw_sizeState(myInstance)) :: &
+real(pReal), dimension(constitutive_phenopowerlaw_sizeState(matID)) :: &
constitutive_phenopowerlaw_aTolState
- constitutive_phenopowerlaw_aTolState(1:constitutive_phenopowerlaw_totalNslip(myInstance)+ &
- constitutive_phenopowerlaw_totalNtwin(myInstance)) = &
- constitutive_phenopowerlaw_aTolResistance(myInstance)
- constitutive_phenopowerlaw_aTolState(1+constitutive_phenopowerlaw_totalNslip(myInstance)+ &
- constitutive_phenopowerlaw_totalNtwin(myInstance)) = &
- constitutive_phenopowerlaw_aTolShear(myInstance)
- constitutive_phenopowerlaw_aTolState(2+constitutive_phenopowerlaw_totalNslip(myInstance)+ &
- constitutive_phenopowerlaw_totalNtwin(myInstance)) = &
- constitutive_phenopowerlaw_aTolTwinFrac(myInstance)
- constitutive_phenopowerlaw_aTolState(3+constitutive_phenopowerlaw_totalNslip(myInstance)+ &
- constitutive_phenopowerlaw_totalNtwin(myInstance): &
- 2+2*(constitutive_phenopowerlaw_totalNslip(myInstance)+ &
- constitutive_phenopowerlaw_totalNtwin(myInstance))) = &
- constitutive_phenopowerlaw_aTolShear(myInstance)
+ constitutive_phenopowerlaw_aTolState(1:constitutive_phenopowerlaw_totalNslip(matID)+ &
+ constitutive_phenopowerlaw_totalNtwin(matID)) = &
+ constitutive_phenopowerlaw_aTolResistance(matID)
+ constitutive_phenopowerlaw_aTolState(1+constitutive_phenopowerlaw_totalNslip(matID)+ &
+ constitutive_phenopowerlaw_totalNtwin(matID)) = &
+ constitutive_phenopowerlaw_aTolShear(matID)
+ constitutive_phenopowerlaw_aTolState(2+constitutive_phenopowerlaw_totalNslip(matID)+ &
+ constitutive_phenopowerlaw_totalNtwin(matID)) = &
+ constitutive_phenopowerlaw_aTolTwinFrac(matID)
+ constitutive_phenopowerlaw_aTolState(3+constitutive_phenopowerlaw_totalNslip(matID)+ &
+ constitutive_phenopowerlaw_totalNtwin(matID): &
+ 2+2*(constitutive_phenopowerlaw_totalNslip(matID)+ &
+ constitutive_phenopowerlaw_totalNtwin(matID))) = &
+ constitutive_phenopowerlaw_aTolShear(matID)
end function constitutive_phenopowerlaw_aTolState
@@ -735,7 +736,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar
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 2nd Piola Kirchhoff stress
+ dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress
real(pReal), dimension(6), intent(in) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
@@ -896,9 +897,15 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,temperature,state,ipc,ip,el
real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
constitutive_phenopowerlaw_dotState
- integer(pInt) :: matID,nSlip,nTwin,f,i,j,k,structID, &
- index_Gamma,index_F,offset_accshear_slip,offset_accshear_twin,index_myFamily
- real(pReal) :: c_SlipSlip,c_SlipTwin,c_TwinSlip,c_TwinTwin, ssat_offset
+ integer(pInt) :: &
+ matID,structID, &
+ nSlip,nTwin, &
+ f,i,j,k, &
+ index_Gamma,index_F,index_myFamily, &
+ offset_accshear_slip,offset_accshear_twin
+ real(pReal) :: &
+ c_SlipSlip,c_SlipTwin,c_TwinSlip,c_TwinTwin, &
+ ssat_offset
real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
gdot_slip,tau_slip_pos,tau_slip_neg,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip
@@ -1028,7 +1035,7 @@ end function constitutive_phenopowerlaw_dotState
!> @brief (instantaneous) incremental change of microstructure
!> @details dummy function, returns 0.0
!--------------------------------------------------------------------------------------------------
-function constitutive_phenopowerlaw_deltaState(Tstar_v,temperature,state,ipc,ip,el)
+pure function constitutive_phenopowerlaw_deltaState(Tstar_v,temperature,state,ipc,ip,el)
use prec, only: &
p_vec
use mesh, only: &
diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90
index 5c8a65f95..9d650f2ac 100644
--- a/code/constitutive_titanmod.f90
+++ b/code/constitutive_titanmod.f90
@@ -33,33 +33,24 @@ module constitutive_titanmod
private
character(len=*), parameter, public :: &
CONSTITUTIVE_TITANMOD_label = 'titanmod'
- character(len=18), dimension(3), parameter :: &
- CONSTITUTIVE_TITANMOD_listBasicSlipStates = ['rho_edge ', &
- 'rho_screw ', &
- 'shear_system']
-
- character(len=18), dimension(1), parameter :: &
+ character(len=18), dimension(3), parameter, private :: &
+ CONSTITUTIVE_TITANMOD_listBasicSlipStates = &
+ ['rho_edge ', 'rho_screw ', 'shear_system']
+ character(len=18), dimension(1), parameter, private :: &
CONSTITUTIVE_TITANMOD_listBasicTwinStates = ['gdot_twin']
-
- character(len=19), dimension(11), parameter :: &
- CONSTITUTIVE_TITANMOD_listDependentSlipStates =['segment_edge ', &
- 'segment_screw ', &
- 'resistance_edge ', &
- 'resistance_screw ', &
- 'tau_slip ', &
- 'velocity_edge ', &
- 'velocity_screw ', &
- 'gdot_slip_edge ', &
- 'gdot_slip_screw ', &
- 'stressratio_edge_p ', &
- 'stressratio_screw_p' &
- ]
-
- character(len=18), dimension(2), parameter :: &
- constitutive_titanmod_listDependentTwinStates =['twin_fraction', &
- 'tau_twin ' &
- ]
- real(pReal), parameter :: kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin
+ character(len=19), dimension(11), parameter, private :: &
+ CONSTITUTIVE_TITANMOD_listDependentSlipStates = &
+ ['segment_edge ', 'segment_screw ', &
+ 'resistance_edge ', 'resistance_screw ', &
+ 'tau_slip ', &
+ 'velocity_edge ', 'velocity_screw ', &
+ 'gdot_slip_edge ', 'gdot_slip_screw ', &
+ 'stressratio_edge_p ', 'stressratio_screw_p' ]
+ character(len=18), dimension(2), parameter, private :: &
+ constitutive_titanmod_listDependentTwinStates = &
+ ['twin_fraction', 'tau_twin ']
+ real(pReal), parameter, private :: &
+ kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin
integer(pInt), dimension(:), allocatable, public, protected :: &
@@ -73,18 +64,18 @@ module constitutive_titanmod
character(len=64), dimension(:,:), allocatable, target, public :: &
constitutive_titanmod_output !< name of each post result output
- integer(pInt), dimension(:), allocatable :: &
+ integer(pInt), dimension(:), allocatable, private :: &
constitutive_titanmod_Noutput !< number of outputs per instance of this plasticity
character(len=32), dimension(:), allocatable, public, protected :: &
constitutive_titanmod_structureName !< name of the lattice structure
- integer(pInt), dimension(:), allocatable :: &
+ integer(pInt), dimension(:), allocatable, private :: &
constitutive_titanmod_structure, & !< number representing the kind of lattice structure
constitutive_titanmod_totalNslip, & !< total number of active slip systems for each instance
constitutive_titanmod_totalNtwin !< total number of active twin systems for each instance
- integer(pInt), dimension(:,:), allocatable :: &
+ integer(pInt), dimension(:,:), allocatable, private :: &
constitutive_titanmod_Nslip, & !< number of active slip systems for each family and instance
constitutive_titanmod_Ntwin, & !< number of active twin systems for each family and instance
constitutive_titanmod_slipFamily, & !< lookup table relating active slip system to slip family for each instance
@@ -92,7 +83,7 @@ module constitutive_titanmod
constitutive_titanmod_slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance
constitutive_titanmod_twinSystemLattice !< lookup table relating active twin system index to lattice twin system index for each instance
-real(pReal), dimension(:), allocatable :: &
+ real(pReal), dimension(:), allocatable, private :: &
constitutive_titanmod_CoverA, & !< c/a ratio for hex type lattice
constitutive_titanmod_debyefrequency, & !< Debye frequency
constitutive_titanmod_kinkf0, & !<
@@ -108,7 +99,7 @@ real(pReal), dimension(:), allocatable :: &
constitutive_titanmod_Cthresholdtwin, & !< Not being used
constitutive_titanmod_aTolRho !< absolute tolerance for integration of dislocation density
-real(pReal), dimension(:,:), allocatable :: &
+ real(pReal), dimension(:,:), allocatable, private :: &
constitutive_titanmod_rho_edge0, & !< initial edge dislocation density per slip system for each family and instance
constitutive_titanmod_rho_screw0, & !< initial screw dislocation density per slip system for each family and instance
constitutive_titanmod_shear_system0, & !< accumulated shear on each system
@@ -168,7 +159,7 @@ real(pReal), dimension(:,:), allocatable :: &
constitutive_titanmod_interactionTwinSlip, & !< coefficients for twin-slip interaction for each interaction type and instance
constitutive_titanmod_interactionTwinTwin !< coefficients for twin-twin interaction for each interaction type and instance
- real(pReal), dimension(:,:,:),allocatable :: &
+ real(pReal), dimension(:,:,:), allocatable, private :: &
constitutive_titanmod_Cslip_66, & !< elasticity matrix in Mandel notation for each instance
constitutive_titanmod_interactionMatrixSlipSlip, & !< interaction matrix of the different slip systems for each instance
constitutive_titanmod_interactionMatrix_ee, & !< interaction matrix of e-e for each instance
@@ -182,13 +173,13 @@ real(pReal), dimension(:,:), allocatable :: &
constitutive_titanmod_TwinforestProjectionEdge, & !< matrix of forest projections of edge dislocations in twin system for each instance
constitutive_titanmod_TwinforestProjectionScrew !< matrix of forest projections of screw dislocations in twin system for each instance
- real(pReal), dimension(:,:,:,:), allocatable :: &
+ real(pReal), dimension(:,:,:,:), allocatable, private :: &
constitutive_titanmod_Ctwin_66 !< twin elasticity matrix in Mandel notation for each instance
- real(pReal), dimension(:,:,:,:,:), allocatable :: &
+ real(pReal), dimension(:,:,:,:,:), allocatable, private :: &
constitutive_titanmod_Cslip_3333 !< elasticity matrix for each instance
- real(pReal), dimension(:,:,:,:,:,:), allocatable :: &
+ real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: &
constitutive_titanmod_Ctwin_3333 !< twin elasticity matrix for each instance
@@ -232,11 +223,17 @@ subroutine constitutive_titanmod_init(myFile)
integer(pInt), parameter :: MAXNCHUNKS = 21_pInt
integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions
integer(pInt), dimension(7) :: configNchunks
- integer(pInt) :: section = 0_pInt,f,i,j,k,l,m,n,o,p,q,r,s,s1,s2,t,t1,t2,ns,nt,&
+ integer(pInt) :: &
+ section = 0_pInt, &
+ i, j, k, l, m, n, p, q, r, &
+ f, o, &
+ s, s1, s2, &
+ t, t1, t2, &
+ ns, nt, &
Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, &
Nchunks_SlipFamilies, Nchunks_TwinFamilies, &
- mySize,myStructure,maxTotalNslip,maxTotalNtwin, &
- maxNinstance
+ mySize, structID, &
+ maxTotalNslip,maxTotalNtwin, maxNinstance
character(len=65536) :: &
tag = '', &
line = '' ! to start initialized
@@ -247,7 +244,7 @@ subroutine constitutive_titanmod_init(myFile)
#include "compilation_info.f90"
maxNinstance = int(count(phase_plasticity == CONSTITUTIVE_TITANMOD_label),pInt)
- if (maxNinstance == 0) return
+ if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
@@ -613,9 +610,9 @@ subroutine constitutive_titanmod_init(myFile)
sanityChecks: do i = 1_pInt,maxNinstance
constitutive_titanmod_structure(i) = &
lattice_initializeStructure(constitutive_titanmod_structureName(i),constitutive_titanmod_CoverA(i))
- myStructure = constitutive_titanmod_structure(i)
+ structID = constitutive_titanmod_structure(i)
- if (myStructure < 1_pInt) call IO_error(205_pInt,el=i)
+ if (structID < 1_pInt) call IO_error(205_pInt,el=i)
if (sum(constitutive_titanmod_Nslip(:,i)) <= 0_pInt) call IO_error(211_pInt,el=i,ext_msg='nslip (' &
//CONSTITUTIVE_TITANMOD_label//')')
if (sum(constitutive_titanmod_Ntwin(:,i)) < 0_pInt) call IO_error(211_pInt,el=i,ext_msg='ntwin (' &
@@ -670,9 +667,10 @@ subroutine constitutive_titanmod_init(myFile)
if (constitutive_titanmod_aTolRho(i) <= 0.0_pReal) call IO_error(211_pInt,el=i,ext_msg='aTolRho (' &
//CONSTITUTIVE_TITANMOD_label//')')
- !* Determine total number of active slip or twin systems
- constitutive_titanmod_Nslip(:,i) = min(lattice_NslipSystem(:,myStructure),constitutive_titanmod_Nslip(:,i))
- constitutive_titanmod_Ntwin(:,i) = min(lattice_NtwinSystem(:,myStructure),constitutive_titanmod_Ntwin(:,i))
+!--------------------------------------------------------------------------------------------------
+! determine total number of active slip or twin systems
+ constitutive_titanmod_Nslip(:,i) = min(lattice_NslipSystem(:,structID),constitutive_titanmod_Nslip(:,i))
+ constitutive_titanmod_Ntwin(:,i) = min(lattice_NtwinSystem(:,structID),constitutive_titanmod_Ntwin(:,i))
constitutive_titanmod_totalNslip(i) = sum(constitutive_titanmod_Nslip(:,i))
constitutive_titanmod_totalNtwin(i) = sum(constitutive_titanmod_Ntwin(:,i))
enddo sanityChecks
@@ -683,8 +681,7 @@ subroutine constitutive_titanmod_init(myFile)
maxTotalNtwin = maxval(constitutive_titanmod_totalNtwin)
allocate(constitutive_titanmod_burgersPerSlipSys(maxTotalNslip, maxNinstance))
- allocate(constitutive_titanmod_burgersPerTwinSys(maxTotalNtwin, maxNinstance))
- constitutive_titanmod_burgersPerTwinSys = 0.0_pReal
+ constitutive_titanmod_burgersPerSlipSys = 0.0_pReal
allocate(constitutive_titanmod_f0_PerSlipSys(maxTotalNslip,maxNinstance))
constitutive_titanmod_f0_PerSlipSys = 0.0_pReal
@@ -715,6 +712,8 @@ subroutine constitutive_titanmod_init(myFile)
allocate(constitutive_titanmod_CsLambdaSlipPerSlipSys(maxTotalNslip, maxNinstance))
constitutive_titanmod_CsLambdaSlipPerSlipSys = 0.0_pReal
+ allocate(constitutive_titanmod_burgersPerTwinSys (maxTotalNtwin,maxNinstance))
+ constitutive_titanmod_burgersPerTwinSys = 0.0_pReal
allocate(constitutive_titanmod_twinf0_PerTwinSys(maxTotalNTwin,maxNinstance))
constitutive_titanmod_twinf0_PerTwinSys = 0.0_pReal
allocate(constitutive_titanmod_twinshearconstant_PerTwinSys(maxTotalNTwin,maxNinstance))
@@ -731,6 +730,10 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_twinsizePerTwinSys = 0.0_pReal
allocate(constitutive_titanmod_twinLambdaSlipPerTwinSys(maxTotalNtwin, maxNinstance))
constitutive_titanmod_twinLambdaSlipPerTwinSys = 0.0_pReal
+ allocate(constitutive_titanmod_Ctwin_66 (6,6,maxTotalNtwin,maxNinstance))
+ constitutive_titanmod_Ctwin_66 = 0.0_pReal
+ allocate(constitutive_titanmod_Ctwin_3333 (3,3,3,3,maxTotalNtwin,maxNinstance))
+ constitutive_titanmod_Ctwin_3333 = 0.0_pReal
allocate(constitutive_titanmod_interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstance))
constitutive_titanmod_interactionMatrixSlipSlip = 0.0_pReal
@@ -755,93 +758,81 @@ subroutine constitutive_titanmod_init(myFile)
allocate(constitutive_titanmod_TwinforestProjectionScrew(maxTotalNtwin,maxTotalNtwin,maxNinstance))
constitutive_titanmod_TwinforestProjectionScrew = 0.0_pReal
- allocate(constitutive_titanmod_Ctwin_66(6,6,maxTotalNtwin,maxNinstance))
- allocate(constitutive_titanmod_Ctwin_3333(3,3,3,3,maxTotalNtwin,maxNinstance))
- constitutive_titanmod_Ctwin_66 = 0.0_pReal
- constitutive_titanmod_Ctwin_3333 = 0.0_pReal
+
instancesLoop: do i = 1_pInt,maxNinstance
- myStructure = constitutive_titanmod_structure(i)
+ structID = constitutive_titanmod_structure(i)
- !* Inverse lookup of slip system family
+!--------------------------------------------------------------------------------------------------
+! inverse lookup of slip system family
l = 0_pInt
do f = 1_pInt,lattice_maxNslipFamily
- do k = 1_pInt,constitutive_titanmod_Nslip(f,i)
+ do s = 1_pInt,constitutive_titanmod_Nslip(f,i)
l = l + 1_pInt
constitutive_titanmod_slipFamily(l,i) = f
- constitutive_titanmod_slipSystemLattice(l,i) = sum(lattice_NslipSystem(1:f-1_pInt,myStructure)) + k
+ constitutive_titanmod_slipSystemLattice(l,i) = sum(lattice_NslipSystem(1:f-1_pInt,structID)) + s
enddo; enddo
- !* Inverse lookup of twin system family
+!--------------------------------------------------------------------------------------------------
+! inverse lookup of twin system family
l = 0_pInt
do f = 1_pInt,lattice_maxNtwinFamily
- do k = 1_pInt,constitutive_titanmod_Ntwin(f,i)
+ do t = 1_pInt,constitutive_titanmod_Ntwin(f,i)
l = l + 1_pInt
constitutive_titanmod_twinFamily(l,i) = f
- constitutive_titanmod_twinSystemLattice(l,i) = sum(lattice_NtwinSystem(1:f-1_pInt,myStructure)) + k
+ constitutive_titanmod_twinSystemLattice(l,i) = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) + t
enddo; enddo
- !* Determine size of state array
+!--------------------------------------------------------------------------------------------------
+! determine size of state array
ns = constitutive_titanmod_totalNslip(i)
nt = constitutive_titanmod_totalNtwin(i)
constitutive_titanmod_sizeDotState(i) = &
- size(constitutive_titanmod_listBasicSlipStates)*ns+size(constitutive_titanmod_listBasicTwinStates)*nt
+ size(constitutive_titanmod_listBasicSlipStates)*ns + &
+ size(constitutive_titanmod_listBasicTwinStates)*nt
constitutive_titanmod_sizeState(i) = &
constitutive_titanmod_sizeDotState(i)+ &
- size(constitutive_titanmod_listDependentSlipStates)*ns+size(constitutive_titanmod_listDependentTwinStates)*nt
+ size(constitutive_titanmod_listDependentSlipStates)*ns + &
+ size(constitutive_titanmod_listDependentTwinStates)*nt
- !* Determine size of postResults array
-
- do o = 1_pInt,constitutive_titanmod_Noutput(i)
+!--------------------------------------------------------------------------------------------------
+! determine size of postResults array
+ outputsLoop: do o = 1_pInt,constitutive_titanmod_Noutput(i)
mySize = 0_pInt
select case(constitutive_titanmod_output(o,i))
- case('rhoedge', &
- 'rhoscrew', &
- 'segment_edge', &
- 'segment_screw', &
- 'resistance_edge', &
- 'resistance_screw', &
- 'velocity_edge', &
- 'velocity_screw', &
+ case('rhoedge', 'rhoscrew', &
+ 'segment_edge', 'segment_screw', &
+ 'resistance_edge', 'resistance_screw', &
+ 'velocity_edge', 'velocity_screw', &
'tau_slip', &
- 'gdot_slip_edge', &
- 'gdot_slip_screw', &
+ 'gdot_slip_edge', 'gdot_slip_screw', &
'gdot_slip', &
- 'stressratio_edge_p', &
- 'stressratio_screw_p', &
+ 'stressratio_edge_p', 'stressratio_screw_p', &
'shear_system')
mySize = constitutive_titanmod_totalNslip(i)
case('twin_fraction', &
'gdot_twin', &
'tau_twin' )
mySize = constitutive_titanmod_totalNtwin(i)
- case('shear_basal', & ! use only if all 4 slip families in hex are considered
- 'shear_prism', & ! use only if all 4 slip families in hex are considered
- 'shear_pyra', & ! use only if all 4 slip families in hex are considered
- 'shear_pyrca', & ! use only if all 4 slip families in hex are considered
- 'rhoedge_basal', &
- 'rhoedge_prism', &
- 'rhoedge_pyra', &
- 'rhoedge_pyrca', &
- 'rhoscrew_basal', &
- 'rhoscrew_prism', &
- 'rhoscrew_pyra', &
- 'rhoscrew_pyrca', &
+ case('shear_basal', 'shear_prism', 'shear_pyra', 'shear_pyrca', & ! use only if all 4 slip families in hex are considered
+ 'rhoedge_basal', 'rhoedge_prism', 'rhoedge_pyra', 'rhoedge_pyrca', &
+ 'rhoscrew_basal', 'rhoscrew_prism', 'rhoscrew_pyra', 'rhoscrew_pyrca', &
'shear_total')
mySize = 1_pInt
case default
- call IO_error(212_pInt,ext_msg=constitutive_titanmod_output(o,i)//' ('//CONSTITUTIVE_TITANMOD_label//')')
+ call IO_error(212_pInt,ext_msg=constitutive_titanmod_output(o,i)// &
+ ' ('//CONSTITUTIVE_TITANMOD_label//')')
end select
- if (mySize > 0_pInt) then ! any meaningful output found
+ outputFound: if (mySize > 0_pInt) then
constitutive_titanmod_sizePostResult(o,i) = mySize
constitutive_titanmod_sizePostResults(i) = constitutive_titanmod_sizePostResults(i) + mySize
- endif
- enddo
+ endif outputFound
+ enddo outputsLoop
- !* Elasticity matrix and shear modulus according to material.config
- constitutive_titanmod_Cslip_66(:,:,i) = lattice_symmetrizeC66(constitutive_titanmod_structureName(i),&
- constitutive_titanmod_Cslip_66(:,:,i))
+ constitutive_titanmod_Cslip_66(1:6,1:6,i) = &
+ lattice_symmetrizeC66(constitutive_titanmod_structureName(i),&
+ constitutive_titanmod_Cslip_66(1:6,1:6,i)) ! assign elasticity tensor
constitutive_titanmod_Gmod(i) = &
0.2_pReal*(constitutive_titanmod_Cslip_66(1,1,i)-constitutive_titanmod_Cslip_66(1,2,i))&
+ 0.3_pReal*constitutive_titanmod_Cslip_66(4,4,i)
@@ -850,7 +841,8 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_Cslip_3333(1:3,1:3,1:3,1:3,i) = &
math_Voigt66to3333(constitutive_titanmod_Cslip_66(1:6,1:6,i))
- !* Construction of the twin elasticity matrices
+!--------------------------------------------------------------------------------------------------
+! construction of the twin elasticity matrices
do j=1_pInt,lattice_maxNtwinFamily
do k=1_pInt,constitutive_titanmod_Ntwin(j,i)
do l=1_pInt,3_pInt ; do m=1_pInt,3_pInt ; do n=1_pInt,3_pInt ; do o=1_pInt,3_pInt
@@ -858,17 +850,18 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_Ctwin_3333(l,m,n,o,sum(constitutive_titanmod_Nslip(1:j-1_pInt,i))+k,i) = &
constitutive_titanmod_Ctwin_3333(l,m,n,o,sum(constitutive_titanmod_Nslip(1:j-1_pInt,i))+k,i) + &
constitutive_titanmod_Cslip_3333(p,q,r,s,i)*&
- lattice_Qtwin(l,p,sum(lattice_NslipSystem(1:j-1_pInt,myStructure))+k,myStructure)* &
- lattice_Qtwin(m,q,sum(lattice_NslipSystem(1:j-1_pInt,myStructure))+k,myStructure)* &
- lattice_Qtwin(n,r,sum(lattice_NslipSystem(1:j-1_pInt,myStructure))+k,myStructure)* &
- lattice_Qtwin(o,s,sum(lattice_NslipSystem(1:j-1_pInt,myStructure))+k,myStructure)
+ lattice_Qtwin(l,p,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID)* &
+ lattice_Qtwin(m,q,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID)* &
+ lattice_Qtwin(n,r,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID)* &
+ lattice_Qtwin(o,s,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID)
enddo; enddo; enddo; enddo
enddo; enddo; enddo ; enddo
constitutive_titanmod_Ctwin_66(1:6,1:6,k,i) = &
math_Mandel3333to66(constitutive_titanmod_Ctwin_3333(1:3,1:3,1:3,1:3,k,i))
enddo; enddo
- !* Burgers vector, dislocation velocity prefactor for each slip system
+!--------------------------------------------------------------------------------------------------
+! Burgers vector, dislocation velocity prefactor for each slip system
do s = 1_pInt,constitutive_titanmod_totalNslip(i)
f = constitutive_titanmod_slipFamily(s,i)
constitutive_titanmod_burgersPerSlipSys(s,i) = constitutive_titanmod_burgersPerSlipFam(f,i)
@@ -888,7 +881,8 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_CsLambdaSlipPerSlipSys(s,i) = constitutive_titanmod_CsLambdaSlipPerSlipFam(f,i)
enddo
- !* Burgers vector, nucleation rate prefactor and twin size for each twin system
+!--------------------------------------------------------------------------------------------------
+! Burgers vector, nucleation rate prefactor and twin size for each twin system
do t = 1_pInt,constitutive_titanmod_totalNtwin(i)
f = constitutive_titanmod_twinFamily(t,i)
constitutive_titanmod_burgersPerTwinSys(t,i) = constitutive_titanmod_burgersPerTwinFam(f,i)
@@ -902,25 +896,26 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_twinLambdaSlipPerTwinSys(t,i) = constitutive_titanmod_twinLambdaSlipPerTwinFam(f,i)
enddo
- !* Construction of interaction matrices
+!--------------------------------------------------------------------------------------------------
+! Construction of interaction matrices
do s1 = 1_pInt,constitutive_titanmod_totalNslip(i)
do s2 = 1_pInt,constitutive_titanmod_totalNslip(i)
constitutive_titanmod_interactionMatrixSlipSlip(s1,s2,i) = &
constitutive_titanmod_interactionSlipSlip(lattice_interactionSlipSlip(constitutive_titanmod_slipSystemLattice(s1,i), &
constitutive_titanmod_slipSystemLattice(s2,i), &
- myStructure),i)
+ structID),i)
constitutive_titanmod_interactionMatrix_ee(s1,s2,i) = &
constitutive_titanmod_interaction_ee(lattice_interactionSlipSlip(constitutive_titanmod_slipSystemLattice(s1,i), &
constitutive_titanmod_slipSystemLattice(s2,i), &
- myStructure),i)
+ structID),i)
constitutive_titanmod_interactionMatrix_ss(s1,s2,i) = &
constitutive_titanmod_interaction_ss(lattice_interactionSlipSlip(constitutive_titanmod_slipSystemLattice(s1,i), &
constitutive_titanmod_slipSystemLattice(s2,i), &
- myStructure),i)
+ structID),i)
constitutive_titanmod_interactionMatrix_es(s1,s2,i) = &
constitutive_titanmod_interaction_es(lattice_interactionSlipSlip(constitutive_titanmod_slipSystemLattice(s1,i), &
constitutive_titanmod_slipSystemLattice(s2,i), &
- myStructure),i)
+ structID),i)
enddo; enddo
do s1 = 1_pInt,constitutive_titanmod_totalNslip(i)
@@ -928,7 +923,7 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_interactionMatrixSlipTwin(s1,t2,i) = &
constitutive_titanmod_interactionSlipTwin(lattice_interactionSlipTwin(constitutive_titanmod_slipSystemLattice(s1,i), &
constitutive_titanmod_twinSystemLattice(t2,i), &
- myStructure),i)
+ structID),i)
enddo; enddo
do t1 = 1_pInt,constitutive_titanmod_totalNtwin(i)
@@ -936,7 +931,7 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_interactionMatrixTwinSlip(t1,s2,i) = &
constitutive_titanmod_interactionTwinSlip(lattice_interactionTwinSlip(constitutive_titanmod_twinSystemLattice(t1,i), &
constitutive_titanmod_slipSystemLattice(s2,i), &
- myStructure),i)
+ structID),i)
enddo; enddo
do t1 = 1_pInt,constitutive_titanmod_totalNtwin(i)
@@ -944,32 +939,37 @@ subroutine constitutive_titanmod_init(myFile)
constitutive_titanmod_interactionMatrixTwinTwin(t1,t2,i) = &
constitutive_titanmod_interactionTwinTwin(lattice_interactionTwinTwin(constitutive_titanmod_twinSystemLattice(t1,i), &
constitutive_titanmod_twinSystemLattice(t2,i), &
- myStructure),i)
+ structID),i)
enddo; enddo
-
- !* Calculation of forest projections for edge dislocations
+
do s1 = 1_pInt,constitutive_titanmod_totalNslip(i)
do s2 = 1_pInt,constitutive_titanmod_totalNslip(i)
+!--------------------------------------------------------------------------------------------------
+! calculation of forest projections for edge dislocations
constitutive_titanmod_forestProjectionEdge(s1,s2,i) = &
- abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,i),myStructure), &
- lattice_st(:,constitutive_titanmod_slipSystemLattice(s2,i),myStructure)))
- !* Calculation of forest projections for screw dislocations
+ abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,i),structID), &
+ lattice_st(:,constitutive_titanmod_slipSystemLattice(s2,i),structID)))
+
+!--------------------------------------------------------------------------------------------------
+! calculation of forest projections for screw dislocations
constitutive_titanmod_forestProjectionScrew(s1,s2,i) = &
- abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,i),myStructure), &
- lattice_sd(:,constitutive_titanmod_slipSystemLattice(s2,i),myStructure)))
+ abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,i),structID), &
+ lattice_sd(:,constitutive_titanmod_slipSystemLattice(s2,i),structID)))
enddo; enddo
-
- !* Calculation of forest projections for edge dislocations in twin system
+!--------------------------------------------------------------------------------------------------
+! calculation of forest projections for edge dislocations in twin system
do t1 = 1_pInt,constitutive_titanmod_totalNtwin(i)
do t2 = 1_pInt,constitutive_titanmod_totalNtwin(i)
constitutive_titanmod_TwinforestProjectionEdge(t1,t2,i) = &
- abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,i),myStructure), &
- lattice_tt(:,constitutive_titanmod_twinSystemLattice(t2,i),myStructure)))
- !* Calculation of forest projections for screw dislocations in twin system
+ abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,i),structID), &
+ lattice_tt(:,constitutive_titanmod_twinSystemLattice(t2,i),structID)))
+
+!--------------------------------------------------------------------------------------------------
+! calculation of forest projections for screw dislocations in twin system
constitutive_titanmod_TwinforestProjectionScrew(t1,t2,i) = &
- abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,i),myStructure), &
- lattice_td(:,constitutive_titanmod_twinSystemLattice(t2,i),myStructure)))
+ abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,i),structID), &
+ lattice_td(:,constitutive_titanmod_twinSystemLattice(t2,i),structID)))
enddo; enddo
enddo instancesLoop
@@ -978,75 +978,79 @@ end subroutine constitutive_titanmod_init
!--------------------------------------------------------------------------------------------------
-!> @brief sets the relevant state values for a given instance of this plasticity
+!> @brief sets the initial microstructural state for a given instance of this plasticity
!--------------------------------------------------------------------------------------------------
-pure function constitutive_titanmod_stateInit(myInstance)
+pure function constitutive_titanmod_stateInit(matID)
use lattice, only: &
lattice_maxNslipFamily, &
lattice_maxNtwinFamily
implicit none
- integer(pInt), intent(in) :: myInstance !< number specifying the instance of the plasticity
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
+ real(pReal), dimension(constitutive_titanmod_sizeState(matID)) :: &
+ constitutive_titanmod_stateInit
- real(pReal), dimension(constitutive_titanmod_sizeState(myInstance)) :: &
- constitutive_titanmod_stateInit
- integer(pInt) :: s,s0,s1, &
- t,t0,t1, &
- ns,nt,f
- real(pReal), dimension(constitutive_titanmod_totalNslip(myInstance)) :: rho_edge0, &
- rho_screw0, &
- shear_system0, &
- segment_edge0, &
- segment_screw0, &
- resistance_edge0, &
- resistance_screw0
- real(pReal), dimension(constitutive_titanmod_totalNtwin(myInstance)) :: twingamma_dot0, &
- resistance_twin0
+ integer(pInt) :: &
+ s,s0,s1, &
+ t,t0,t1, &
+ ns,nt,f
+ real(pReal), dimension(constitutive_titanmod_totalNslip(matID)) :: &
+ rho_edge0, &
+ rho_screw0, &
+ shear_system0, &
+ segment_edge0, &
+ segment_screw0, &
+ resistance_edge0, &
+ resistance_screw0
+ real(pReal), dimension(constitutive_titanmod_totalNtwin(matID)) :: &
+ twingamma_dot0, &
+ resistance_twin0
- ns = constitutive_titanmod_totalNslip(myInstance)
- nt = constitutive_titanmod_totalNtwin(myInstance)
+ ns = constitutive_titanmod_totalNslip(matID)
+ nt = constitutive_titanmod_totalNtwin(matID)
- !* Initialize basic slip state variables
- ! For slip
+!--------------------------------------------------------------------------------------------------
+! 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,myInstance) - 1_pInt
+ s1 = s0 + constitutive_titanmod_Nslip(f,matID) - 1_pInt
do s = s0,s1
- rho_edge0(s) = constitutive_titanmod_rho_edge0(f,myInstance)
- rho_screw0(s) = constitutive_titanmod_rho_screw0(f,myInstance)
+ rho_edge0(s) = constitutive_titanmod_rho_edge0(f,matID)
+ rho_screw0(s) = constitutive_titanmod_rho_screw0(f,matID)
shear_system0(s) = 0.0_pReal
enddo
enddo
- !* Initialize basic slip state variables
- ! For twin
+!--------------------------------------------------------------------------------------------------
+! 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,myInstance) - 1_pInt
+ t1 = t0 + constitutive_titanmod_Ntwin(f,matID) - 1_pInt
do t = t0,t1
twingamma_dot0(t)=0.0_pReal
enddo
enddo
- !* Initialize dependent slip microstructural variables
+!--------------------------------------------------------------------------------------------------
+! initialize dependent slip microstructural variables
forall (s = 1_pInt:ns)
- segment_edge0(s) = constitutive_titanmod_CeLambdaSlipPerSlipSys(s,myInstance)/ &
- sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,myInstance))+ &
- dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,myInstance)))
- segment_screw0(s) = constitutive_titanmod_CsLambdaSlipPerSlipSys(s,myInstance)/ &
- sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,myInstance))+ &
- dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,myInstance)))
+ segment_edge0(s) = constitutive_titanmod_CeLambdaSlipPerSlipSys(s,matID)/ &
+ sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,matID))+ &
+ dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,matID)))
+ segment_screw0(s) = constitutive_titanmod_CsLambdaSlipPerSlipSys(s,matID)/ &
+ sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,matID))+ &
+ dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,matID)))
resistance_edge0(s) = &
- constitutive_titanmod_Gmod(myInstance)*constitutive_titanmod_burgersPerSlipSys(s,myInstance)* &
- sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_ee(1:ns,s,myInstance))+ &
- dot_product((rho_screw0),constitutive_titanmod_interactionMatrix_es(1:ns,s,myInstance)))
+ constitutive_titanmod_Gmod(matID)*constitutive_titanmod_burgersPerSlipSys(s,matID)* &
+ sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_ee(1:ns,s,matID))+ &
+ dot_product((rho_screw0),constitutive_titanmod_interactionMatrix_es(1:ns,s,matID)))
resistance_screw0(s) = &
- constitutive_titanmod_Gmod(myInstance)*constitutive_titanmod_burgersPerSlipSys(s,myInstance)* &
- sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_es(1:ns,s,myInstance))+ &
- dot_product((rho_screw0), constitutive_titanmod_interactionMatrix_ss(1:ns,s,myInstance)))
+ constitutive_titanmod_Gmod(matID)*constitutive_titanmod_burgersPerSlipSys(s,matID)* &
+ sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_es(1:ns,s,matID))+ &
+ dot_product((rho_screw0), constitutive_titanmod_interactionMatrix_ss(1:ns,s,matID)))
end forall
forall (t = 1_pInt:nt) &
@@ -1069,52 +1073,71 @@ end function constitutive_titanmod_stateInit
!--------------------------------------------------------------------------------------------------
!> @brief sets the relevant state values for a given instance of this plasticity
!--------------------------------------------------------------------------------------------------
-pure function constitutive_titanmod_aTolState(myInstance)
+pure function constitutive_titanmod_aTolState(matID)
implicit none
- integer(pInt), intent(in) :: myInstance
- real(pReal), dimension(constitutive_titanmod_sizeState(myInstance)) :: constitutive_titanmod_aTolState
+ integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
- constitutive_titanmod_aTolState = constitutive_titanmod_aTolRho(myInstance)
+ real(pReal), dimension(constitutive_titanmod_sizeState(matID)) :: &
+ constitutive_titanmod_aTolState
+
+ constitutive_titanmod_aTolState = constitutive_titanmod_aTolRho(matID)
endfunction constitutive_titanmod_aTolState
+!--------------------------------------------------------------------------------------------------
+!> @brief returns the homogenized elasticity matrix
+!--------------------------------------------------------------------------------------------------
pure function constitutive_titanmod_homogenizedC(state,ipc,ip,el)
-use prec, only: p_vec
-use mesh, only: mesh_NcpElems,mesh_maxNips
-use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance
+ use prec, only: &
+ p_vec
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains, &
+ material_phase, &
+ phase_plasticityInstance
implicit none
-!* Input-Output variables
-integer(pInt), intent(in) :: ipc,ip,el
-type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state
-real(pReal), dimension(6,6) :: constitutive_titanmod_homogenizedC
+ real(pReal), dimension(6,6) :: &
+ constitutive_titanmod_homogenizedC
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
+ state !< microstructure state
real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
volumefraction_PerTwinSys
-!* Local variables
- integer(pInt) myInstance,ns,nt,i
- real(pReal) sumf
+ integer(pInt) :: &
+ matID, &
+ ns, nt, &
+ i
+ real(pReal) :: &
+ sumf
- !* Shortened notation
- myInstance = phase_plasticityInstance(material_phase(ipc,ip,el))
- ns = constitutive_titanmod_totalNslip(myInstance)
- nt = constitutive_titanmod_totalNtwin(myInstance)
+!--------------------------------------------------------------------------------------------------
+! shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ ns = constitutive_titanmod_totalNslip(matID)
+ nt = constitutive_titanmod_totalNtwin(matID)
- !* Total twin volume fraction
+!--------------------------------------------------------------------------------------------------
+! total twin volume fraction
do i=1_pInt,nt
volumefraction_PerTwinSys(i)=state(ipc,ip,el)%p(3_pInt*ns+i)/ &
- constitutive_titanmod_twinshearconstant_PerTwinSys(i,myInstance)
+ constitutive_titanmod_twinshearconstant_PerTwinSys(i,matID)
enddo
- !sumf = sum(state(ipc,ip,el)%p((6*ns+7*nt+1):(6*ns+8*nt))) ! safe for nt == 0
sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0
- !* Homogenized elasticity matrix
- constitutive_titanmod_homogenizedC = (1.0_pReal-sumf)*constitutive_titanmod_Cslip_66(:,:,myInstance)
+!--------------------------------------------------------------------------------------------------
+! homogenized elasticity matrix
+ constitutive_titanmod_homogenizedC = (1.0_pReal-sumf)*constitutive_titanmod_Cslip_66(:,:,matID)
do i=1_pInt,nt
constitutive_titanmod_homogenizedC = &
- ! constitutive_titanmod_homogenizedC + state(ipc,ip,el)%p(6*ns+7*nt+i)*constitutive_titanmod_Ctwin_66(:,:,i,myInstance)
- constitutive_titanmod_homogenizedC + volumefraction_PerTwinSys(i)*constitutive_titanmod_Ctwin_66(:,:,i,myInstance)
+ constitutive_titanmod_homogenizedC + volumefraction_PerTwinSys(i)*constitutive_titanmod_Ctwin_66(:,:,i,matID)
enddo
@@ -1124,7 +1147,7 @@ end function constitutive_titanmod_homogenizedC
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
-pure subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el)
+subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el)
use prec, only: &
p_vec
use mesh, only: &
@@ -1136,22 +1159,33 @@ pure subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el
phase_plasticityInstance
implicit none
- !* Input-Output variables
- integer(pInt), intent(in) :: ipc,ip,el
- real(pReal), intent(in) :: Temperature
- type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: state
- !* Local variables
- integer(pInt) myInstance,myStructure,ns,nt,s,t,i
- real(pReal) sumf,sfe
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ real(pReal), intent(in) :: &
+ temperature !< temperature at IP
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: &
+ state !< microstructure state
+
+ integer(pInt) :: &
+ matID, structID, &
+ ns, nt, s, t, &
+ i
+ real(pReal) :: &
+ sumf, &
+ sfe ! stacking fault energy
real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
volumefraction_PerTwinSys
- !* Shortened notation
- myInstance = phase_plasticityInstance(material_phase(ipc,ip,el))
- myStructure = constitutive_titanmod_structure(myInstance)
- ns = constitutive_titanmod_totalNslip(myInstance)
- nt = constitutive_titanmod_totalNtwin(myInstance)
+!--------------------------------------------------------------------------------------------------
+!Shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_titanmod_structure(matID)
+ ns = constitutive_titanmod_totalNslip(matID)
+ nt = constitutive_titanmod_totalNtwin(matID)
+!--------------------------------------------------------------------------------------------------
! Need to update this list
!* State: 1 : ns rho_edge
!* State: ns+1 : 2*ns rho_screw
@@ -1170,61 +1204,60 @@ pure subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el
!* State: 12*ns+2*nt+1 : 13*ns+2*nt StressRatio_edge_p
!* State: 13*ns+2*nt+1 : 14*ns+2*nt StressRatio_screw_p
- !* Total twin volume fraction
+!--------------------------------------------------------------------------------------------------
+! total twin volume fraction
do i=1_pInt,nt
volumefraction_PerTwinSys(i)=state(ipc,ip,el)%p(3_pInt*ns+i)/ &
- constitutive_titanmod_twinshearconstant_PerTwinSys(i,myInstance)
+ constitutive_titanmod_twinshearconstant_PerTwinSys(i,matID)
enddo
-
- !sumf = sum(state(ipc,ip,el)%p((6*ns+7*nt+1):(6*ns+8*nt))) ! safe for nt == 0
+
sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0
- !* Stacking fault energy
sfe = 0.0002_pReal*Temperature-0.0396_pReal
!--------------------------------------------------------------------------------------------------
! average segment length for edge dislocations in matrix
forall (s = 1_pInt:ns) &
- state(ipc,ip,el)%p(3_pInt*ns+nt+s) = constitutive_titanmod_CeLambdaSlipPerSlipSys(s,myInstance)/ &
+ state(ipc,ip,el)%p(3_pInt*ns+nt+s) = constitutive_titanmod_CeLambdaSlipPerSlipSys(s,matID)/ &
sqrt(dot_product(state(ipc,ip,el)%p(1:ns), &
- constitutive_titanmod_forestProjectionEdge(1:ns,s,myInstance))+ &
+ constitutive_titanmod_forestProjectionEdge(1:ns,s,matID))+ &
dot_product(state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns), &
- constitutive_titanmod_forestProjectionScrew(1:ns,s,myInstance)))
+ constitutive_titanmod_forestProjectionScrew(1:ns,s,matID)))
!--------------------------------------------------------------------------------------------------
! average segment length for screw dislocations in matrix
forall (s = 1_pInt:ns) &
- state(ipc,ip,el)%p(4_pInt*ns+nt+s) = constitutive_titanmod_CsLambdaSlipPerSlipSys(s,myInstance)/ &
+ state(ipc,ip,el)%p(4_pInt*ns+nt+s) = constitutive_titanmod_CsLambdaSlipPerSlipSys(s,matID)/ &
sqrt(dot_product(state(ipc,ip,el)%p(1:ns), &
- constitutive_titanmod_forestProjectionEdge(1:ns,s,myInstance))+ &
+ constitutive_titanmod_forestProjectionEdge(1:ns,s,matID))+ &
dot_product(state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns), &
- constitutive_titanmod_forestProjectionScrew(1:ns,s,myInstance)))
+ constitutive_titanmod_forestProjectionScrew(1:ns,s,matID)))
!--------------------------------------------------------------------------------------------------
! threshold stress or slip resistance for edge dislocation motion
forall (s = 1_pInt:ns) &
state(ipc,ip,el)%p(5_pInt*ns+nt+s) = &
- constitutive_titanmod_Gmod(myInstance)*constitutive_titanmod_burgersPerSlipSys(s,myInstance)*&
+ constitutive_titanmod_Gmod(matID)*constitutive_titanmod_burgersPerSlipSys(s,matID)*&
sqrt(dot_product((state(ipc,ip,el)%p(1:ns)),&
- constitutive_titanmod_interactionMatrix_ee(1:ns,s,myInstance))+ &
+ constitutive_titanmod_interactionMatrix_ee(1:ns,s,matID))+ &
dot_product((state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)),&
- constitutive_titanmod_interactionMatrix_es(1:ns,s,myInstance)))
+ constitutive_titanmod_interactionMatrix_es(1:ns,s,matID)))
!--------------------------------------------------------------------------------------------------
! threshold stress or slip resistance for screw dislocation motion
forall (s = 1_pInt:ns) &
state(ipc,ip,el)%p(6_pInt*ns+nt+s) = &
- constitutive_titanmod_Gmod(myInstance)*constitutive_titanmod_burgersPerSlipSys(s,myInstance)*&
+ constitutive_titanmod_Gmod(matID)*constitutive_titanmod_burgersPerSlipSys(s,matID)*&
sqrt(dot_product((state(ipc,ip,el)%p(1:ns)),&
- constitutive_titanmod_interactionMatrix_es(1:ns,s,myInstance))+ &
+ constitutive_titanmod_interactionMatrix_es(1:ns,s,matID))+ &
dot_product((state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)),&
- constitutive_titanmod_interactionMatrix_ss(1:ns,s,myInstance)))
+ constitutive_titanmod_interactionMatrix_ss(1:ns,s,matID)))
!--------------------------------------------------------------------------------------------------
! threshold stress or slip resistance for dislocation motion in twin
forall (t = 1_pInt:nt) &
state(ipc,ip,el)%p(7_pInt*ns+nt+t) = &
- constitutive_titanmod_Gmod(myInstance)*constitutive_titanmod_burgersPerTwinSys(t,myInstance)*&
+ constitutive_titanmod_Gmod(matID)*constitutive_titanmod_burgersPerTwinSys(t,matID)*&
(dot_product((abs(state(ipc,ip,el)%p(2_pInt*ns+1_pInt:2_pInt*ns+nt))),&
- constitutive_titanmod_interactionMatrixTwinTwin(1:nt,t,myInstance)))
+ constitutive_titanmod_interactionMatrixTwinTwin(1:nt,t,matID)))
end subroutine constitutive_titanmod_microstructure
@@ -1272,26 +1305,33 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,&
el !< element
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: &
state !< microstructure state
- integer(pInt) myInstance,myStructure,ns,nt,f,i,j,k,l,m,n,index_myFamily
- real(pReal) sumf,StressRatio_edge_p,minusStressRatio_edge_p,StressRatio_edge_pminus1,StressRatio_screw_p, &
- StressRatio_screw_pminus1, BoltzmannRatioedge, minusStressRatio_screw_p, &
- screwvelocity_prefactor,twinStressRatio_p,twinminusStressRatio_p,twinStressRatio_pminus1, &
- twinDotGamma0,BoltzmannRatioscrew,BoltzmannRatiotwin,bottomstress_edge,bottomstress_screw
+ integer(pInt) :: &
+ index_myFamily, matID,structID, &
+ ns,nt, &
+ f,i,j,k,l,m,n
+ real(pReal) :: sumf, &
+ StressRatio_edge_p, minusStressRatio_edge_p, StressRatio_edge_pminus1, BoltzmannRatioedge, &
+ StressRatio_screw_p, minusStressRatio_screw_p, StressRatio_screw_pminus1, BoltzmannRatioscrew, &
+ twinStressRatio_p, twinminusStressRatio_p, twinStressRatio_pminus1, BoltzmannRatiotwin, &
+ twinDotGamma0, bottomstress_edge, bottomstress_screw, screwvelocity_prefactor
real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333
real(pReal), dimension(constitutive_titanmod_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
- gdot_slip,dgdot_dtauslip,tau_slip, edge_velocity, screw_velocity,gdot_slip_edge,gdot_slip_screw
+ gdot_slip,dgdot_dtauslip,tau_slip, &
+ edge_velocity, screw_velocity, &
+ gdot_slip_edge, gdot_slip_screw
real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
gdot_twin,dgdot_dtautwin,tau_twin, volumefraction_PerTwinSys
- !* Shortened notation
- myInstance = phase_plasticityInstance(material_phase(ipc,ip,el))
- myStructure = constitutive_titanmod_structure(myInstance)
- ns = constitutive_titanmod_totalNslip(myInstance)
- nt = constitutive_titanmod_totalNtwin(myInstance)
+!--------------------------------------------------------------------------------------------------
+! shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_titanmod_structure(matID)
+ ns = constitutive_titanmod_totalNslip(matID)
+ nt = constitutive_titanmod_totalNtwin(matID)
do i=1_pInt,nt
volumefraction_PerTwinSys(i)=state(ipc,ip,el)%p(3_pInt*ns+i)/ &
- constitutive_titanmod_twinshearconstant_PerTwinSys(i,myInstance)
+ constitutive_titanmod_twinshearconstant_PerTwinSys(i,matID)
enddo
@@ -1308,27 +1348,24 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,&
gdot_slip_screw = 0.0_pReal
dgdot_dtauslip = 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,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_titanmod_Nslip(f,myInstance) ! process each (active) slip system in family
+ slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily
+ index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_titanmod_Nslip(f,matID) ! 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,myStructure))
- !*************************************************
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! if(myStructure>=3.and.j>3) then ! for all non-basal slip systems
- if(myStructure==3_pInt) then ! only for prismatic and pyr systems in hex
- screwvelocity_prefactor=constitutive_titanmod_debyefrequency(myInstance)* &
- state(ipc,ip,el)%p(4_pInt*ns+nt+j)*(constitutive_titanmod_burgersPerSlipSys(j,myInstance)/ &
- constitutive_titanmod_kinkcriticallength_PerSlipSys(j,myInstance))**2
+ tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID))
+ if(structID==3_pInt) then ! only for prismatic and pyr systems in hex
+ screwvelocity_prefactor=constitutive_titanmod_debyefrequency(matID)* &
+ state(ipc,ip,el)%p(4_pInt*ns+nt+j)*(constitutive_titanmod_burgersPerSlipSys(j,matID)/ &
+ constitutive_titanmod_kinkcriticallength_PerSlipSys(j,matID))**2
!* Stress ratio for screw ! No slip resistance for screw dislocations, only Peierls stress
- bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,myInstance)
+ bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,matID)
StressRatio_screw_p = ((abs(tau_slip(j)))/ &
( bottomstress_screw) &
- )**constitutive_titanmod_ps_PerSlipSys(j,myInstance)
+ )**constitutive_titanmod_ps_PerSlipSys(j,matID)
if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then
minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p
@@ -1336,18 +1373,18 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,&
minusStressRatio_screw_p=0.001_pReal
endif
- bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,myInstance)
+ bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,matID)
StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/ &
( bottomstress_screw) &
- )**(constitutive_titanmod_ps_PerSlipSys(j,myInstance)-1.0_pReal)
+ )**(constitutive_titanmod_ps_PerSlipSys(j,matID)-1.0_pReal)
!* Boltzmann ratio for screw
- BoltzmannRatioscrew = constitutive_titanmod_kinkf0(myInstance)/(kB*Temperature)
+ BoltzmannRatioscrew = constitutive_titanmod_kinkf0(matID)/(kB*Temperature)
else ! if the structure is not hex or the slip family is basal
- screwvelocity_prefactor=constitutive_titanmod_v0s_PerSlipSys(j,myInstance)
- bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,myInstance)+state(ipc,ip,el)%p(6*ns+nt+j)
- StressRatio_screw_p = ((abs(tau_slip(j)))/( bottomstress_screw ))**constitutive_titanmod_ps_PerSlipSys(j,myInstance)
+ screwvelocity_prefactor=constitutive_titanmod_v0s_PerSlipSys(j,matID)
+ bottomstress_screw=constitutive_titanmod_tau0s_PerSlipSys(j,matID)+state(ipc,ip,el)%p(6*ns+nt+j)
+ StressRatio_screw_p = ((abs(tau_slip(j)))/( bottomstress_screw ))**constitutive_titanmod_ps_PerSlipSys(j,matID)
if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then
minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p
@@ -1356,18 +1393,18 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,&
endif
StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/( bottomstress_screw))** &
- (constitutive_titanmod_ps_PerSlipSys(j,myInstance)-1.0_pReal)
+ (constitutive_titanmod_ps_PerSlipSys(j,matID)-1.0_pReal)
!* Boltzmann ratio for screw
- BoltzmannRatioscrew = constitutive_titanmod_f0_PerSlipSys(j,myInstance)/(kB*Temperature)
+ BoltzmannRatioscrew = constitutive_titanmod_f0_PerSlipSys(j,matID)/(kB*Temperature)
endif
!* Stress ratio for edge
- bottomstress_edge=constitutive_titanmod_tau0e_PerSlipSys(j,myInstance)+state(ipc,ip,el)%p(5*ns+nt+j)
+ bottomstress_edge=constitutive_titanmod_tau0e_PerSlipSys(j,matID)+state(ipc,ip,el)%p(5*ns+nt+j)
StressRatio_edge_p = ((abs(tau_slip(j)))/ &
( bottomstress_edge) &
- )**constitutive_titanmod_pe_PerSlipSys(j,myInstance)
+ )**constitutive_titanmod_pe_PerSlipSys(j,matID)
if((1.0_pReal-StressRatio_edge_p)>0.001_pReal) then
minusStressRatio_edge_p=1.0_pReal-StressRatio_edge_p
@@ -1376,24 +1413,24 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,&
endif
StressRatio_edge_pminus1 = ((abs(tau_slip(j)))/( bottomstress_edge))** &
- (constitutive_titanmod_pe_PerSlipSys(j,myInstance)-1.0_pReal)
+ (constitutive_titanmod_pe_PerSlipSys(j,matID)-1.0_pReal)
!* Boltzmann ratio for edge. For screws it is defined above
- BoltzmannRatioedge = constitutive_titanmod_f0_PerSlipSys(j,myInstance)/(kB*Temperature)
+ BoltzmannRatioedge = constitutive_titanmod_f0_PerSlipSys(j,matID)/(kB*Temperature)
screw_velocity(j) =screwvelocity_prefactor * & ! there is no v0 for screw now because it is included in the prefactor
exp(-BoltzmannRatioscrew*(minusStressRatio_screw_p)** &
- constitutive_titanmod_qs_PerSlipSys(j,myInstance))
+ constitutive_titanmod_qs_PerSlipSys(j,matID))
- edge_velocity(j) =constitutive_titanmod_v0e_PerSlipSys(j,myInstance)*exp(-BoltzmannRatioedge* &
+ edge_velocity(j) =constitutive_titanmod_v0e_PerSlipSys(j,matID)*exp(-BoltzmannRatioedge* &
(minusStressRatio_edge_p)** &
- constitutive_titanmod_qe_PerSlipSys(j,myInstance))
+ constitutive_titanmod_qe_PerSlipSys(j,matID))
!* Shear rates due to edge slip
- gdot_slip_edge(j) = constitutive_titanmod_burgersPerSlipSys(j,myInstance)*(state(ipc,ip,el)%p(j)* &
+ gdot_slip_edge(j) = constitutive_titanmod_burgersPerSlipSys(j,matID)*(state(ipc,ip,el)%p(j)* &
edge_velocity(j))* sign(1.0_pReal,tau_slip(j))
!* Shear rates due to screw slip
- gdot_slip_screw(j) = constitutive_titanmod_burgersPerSlipSys(j,myInstance)*(state(ipc,ip,el)%p(ns+j) * &
+ gdot_slip_screw(j) = constitutive_titanmod_burgersPerSlipSys(j,matID)*(state(ipc,ip,el)%p(ns+j) * &
screw_velocity(j))* sign(1.0_pReal,tau_slip(j))
!Total shear rate
@@ -1408,31 +1445,31 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,&
state(ipc,ip,el)%p(13*ns+2*nt+j)=StressRatio_screw_p
!* Derivatives of shear rates
- dgdot_dtauslip(j) = constitutive_titanmod_burgersPerSlipSys(j,myInstance)*(( &
+ dgdot_dtauslip(j) = constitutive_titanmod_burgersPerSlipSys(j,matID)*(( &
( &
( &
( &
(edge_velocity(j)*state(ipc,ip,el)%p(j))) * &
BoltzmannRatioedge*&
- constitutive_titanmod_pe_PerSlipSys(j,myInstance)* &
- constitutive_titanmod_qe_PerSlipSys(j,myInstance) &
+ constitutive_titanmod_pe_PerSlipSys(j,matID)* &
+ constitutive_titanmod_qe_PerSlipSys(j,matID) &
)/ &
bottomstress_edge &
)*&
StressRatio_edge_pminus1*(minusStressRatio_edge_p)** &
- (constitutive_titanmod_qe_PerSlipSys(j,myInstance)-1.0_pReal) &
+ (constitutive_titanmod_qe_PerSlipSys(j,matID)-1.0_pReal) &
) + &
( &
( &
( &
(state(ipc,ip,el)%p(ns+j) * screw_velocity(j)) * &
BoltzmannRatioscrew* &
- constitutive_titanmod_ps_PerSlipSys(j,myInstance)* &
- constitutive_titanmod_qs_PerSlipSys(j,myInstance) &
+ constitutive_titanmod_ps_PerSlipSys(j,matID)* &
+ constitutive_titanmod_qs_PerSlipSys(j,matID) &
)/ &
bottomstress_screw &
)*&
- StressRatio_screw_pminus1*(minusStressRatio_screw_p)**(constitutive_titanmod_qs_PerSlipSys(j,myInstance)-1.0_pReal) &
+ StressRatio_screw_pminus1*(minusStressRatio_screw_p)**(constitutive_titanmod_qs_PerSlipSys(j,matID)-1.0_pReal) &
) &
) !* sign(1.0_pReal,tau_slip(j))
@@ -1441,47 +1478,47 @@ 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,myStructure)
+ Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,structID)
!* 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,myStructure)*&
- lattice_Sslip(m,n,1,index_myFamily+i,myStructure)
+ lattice_Sslip(k,l,1,index_myFamily+i,structID)*&
+ lattice_Sslip(m,n,1,index_myFamily+i,structID)
enddo
-enddo
+ enddo slipFamiliesLoop
!* Mechanical twinning part
gdot_twin = 0.0_pReal
dgdot_dtautwin = 0.0_pReal
j = 0_pInt
-do f = 1_pInt,lattice_maxNtwinFamily ! loop over all slip families
- index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_titanmod_Ntwin(f,myInstance) ! process each (active) slip system in family
+ twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily
+ index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_titanmod_Ntwin(f,matID) ! 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,myStructure))
+ tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,structID))
!**************************************************************************************
!* Stress ratios
-! StressRatio_r = (state(ipc,ip,el)%p(6*ns+3*nt+j)/tau_twin(j))**constitutive_titanmod_r(myInstance)
+! StressRatio_r = (state(ipc,ip,el)%p(6*ns+3*nt+j)/tau_twin(j))**constitutive_titanmod_r(matID)
!* 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(myInstance)-sumf)*lattice_shearTwin(index_myFamily+i,myStructure)*&
-! state(ipc,ip,el)%p(6*ns+4*nt+j)*constitutive_titanmod_Ndot0PerTwinSys(f,myInstance)*exp(-StressRatio_r)
-! dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_titanmod_r(myInstance))/tau_twin(j))*StressRatio_r
+! (constitutive_titanmod_MaxTwinFraction(matID)-sumf)*lattice_shearTwin(index_myFamily+i,structID)*&
+! state(ipc,ip,el)%p(6*ns+4*nt+j)*constitutive_titanmod_Ndot0PerTwinSys(f,matID)*exp(-StressRatio_r)
+! dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_titanmod_r(matID))/tau_twin(j))*StressRatio_r
! endif
!**************************************************************************************
!* Stress ratio for edge
twinStressRatio_p = ((abs(tau_twin(j)))/ &
- ( constitutive_titanmod_twintau0_PerTwinSys(j,myInstance)+state(ipc,ip,el)%p(7*ns+nt+j)) &
- )**constitutive_titanmod_twinp_PerTwinSys(j,myInstance)
+ ( constitutive_titanmod_twintau0_PerTwinSys(j,matID)+state(ipc,ip,el)%p(7*ns+nt+j)) &
+ )**constitutive_titanmod_twinp_PerTwinSys(j,matID)
if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then
twinminusStressRatio_p=1.0_pReal-twinStressRatio_p
@@ -1490,19 +1527,19 @@ do f = 1_pInt,lattice_maxNtwinFamily ! loop over
endif
twinStressRatio_pminus1 = ((abs(tau_twin(j)))/ &
- ( constitutive_titanmod_twintau0_PerTwinSys(j,myInstance)+state(ipc,ip,el)%p(7*ns+nt+j)) &
- )**(constitutive_titanmod_twinp_PerTwinSys(j,myInstance)-1.0_pReal)
+ ( constitutive_titanmod_twintau0_PerTwinSys(j,matID)+state(ipc,ip,el)%p(7*ns+nt+j)) &
+ )**(constitutive_titanmod_twinp_PerTwinSys(j,matID)-1.0_pReal)
!* Boltzmann ratio
- BoltzmannRatiotwin = constitutive_titanmod_twinf0_PerTwinSys(j,myInstance)/(kB*Temperature)
+ BoltzmannRatiotwin = constitutive_titanmod_twinf0_PerTwinSys(j,matID)/(kB*Temperature)
!* Initial twin shear rates
TwinDotGamma0 = &
- constitutive_titanmod_twingamma0_PerTwinSys(j,myInstance)
+ constitutive_titanmod_twingamma0_PerTwinSys(j,matID)
!* Shear rates due to twin
- gdot_twin(j) =sign(1.0_pReal,tau_twin(j))*constitutive_titanmod_twingamma0_PerTwinSys(j,myInstance)* &
- exp(-BoltzmannRatiotwin*(twinminusStressRatio_p)**constitutive_titanmod_twinq_PerTwinSys(j,myInstance))
+ gdot_twin(j) =sign(1.0_pReal,tau_twin(j))*constitutive_titanmod_twingamma0_PerTwinSys(j,matID)* &
+ exp(-BoltzmannRatiotwin*(twinminusStressRatio_p)**constitutive_titanmod_twinq_PerTwinSys(j,matID))
!* Derivatives of shear rates in twin
@@ -1511,27 +1548,27 @@ do f = 1_pInt,lattice_maxNtwinFamily ! loop over
( &
(abs(gdot_twin(j))) * &
BoltzmannRatiotwin*&
- constitutive_titanmod_twinp_PerTwinSys(j,myInstance)* &
- constitutive_titanmod_twinq_PerTwinSys(j,myInstance) &
+ constitutive_titanmod_twinp_PerTwinSys(j,matID)* &
+ constitutive_titanmod_twinq_PerTwinSys(j,matID) &
)/ &
- constitutive_titanmod_twintau0_PerTwinSys(j,myInstance) &
+ constitutive_titanmod_twintau0_PerTwinSys(j,matID) &
)*&
twinStressRatio_pminus1*(twinminusStressRatio_p)** &
- (constitutive_titanmod_twinq_PerTwinSys(j,myInstance)-1.0_pReal) &
+ (constitutive_titanmod_twinq_PerTwinSys(j,matID)-1.0_pReal) &
) !* sign(1.0_pReal,tau_slip(j))
!* Plastic velocity gradient for mechanical twinning
-! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,myStructure)
- Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,myStructure)
+! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,structID)
+ Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,structID)
!* 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,myStructure)*&
- lattice_Stwin(m,n,index_myFamily+i,myStructure)
+ lattice_Stwin(k,l,index_myFamily+i,structID)*&
+ lattice_Stwin(m,n,index_myFamily+i,structID)
enddo
-enddo
+ enddo twinFamiliesLoop
dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333)
@@ -1541,9 +1578,15 @@ end subroutine constitutive_titanmod_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief calculates the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
-function constitutive_titanmod_dotState(Tstar_v,Temperature,state,ipc,ip,el)
+function constitutive_titanmod_dotState(Tstar_v,temperature,state,ipc,ip,el)
use prec, only: &
p_vec
+ use lattice, only: &
+ lattice_Stwin_v, &
+ lattice_maxNslipFamily, &
+ lattice_maxNtwinFamily, &
+ lattice_NslipSystem, &
+ lattice_NtwinSystem
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
@@ -1551,8 +1594,6 @@ function constitutive_titanmod_dotState(Tstar_v,Temperature,state,ipc,ip,el)
homogenization_maxNgrains, &
material_phase, &
phase_plasticityInstance
-use lattice, only: lattice_maxNslipFamily,lattice_maxNtwinFamily, &
- lattice_NslipSystem,lattice_NtwinSystem, lattice_Stwin_v
implicit none
real(pReal), dimension(6), intent(in):: &
@@ -1568,25 +1609,33 @@ implicit none
real(pReal), dimension(constitutive_titanmod_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
constitutive_titanmod_dotState
-integer(pInt) MyInstance,MyStructure,ns,nt,f,i,j,index_myFamily
-real(pReal) sumf,BoltzmannRatio,&
+ integer(pInt) :: &
+ index_myFamily, matID,structID, &
+ ns,nt,&
+ f,i,j
+ real(pReal) :: &
+ sumf,BoltzmannRatio, &
twinStressRatio_p,twinminusStressRatio_p
real(pReal), dimension(constitutive_titanmod_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
-DotRhoEdgeGeneration,DotRhoEdgeAnnihilation,DotRhoScrewAnnihilation,&
-DotRhoScrewGeneration
-real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: gdot_twin, &
+ DotRhoEdgeGeneration, &
+ DotRhoEdgeAnnihilation, &
+ DotRhoScrewGeneration, &
+ DotRhoScrewAnnihilation
+ real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
+ gdot_twin, &
tau_twin, &
volumefraction_PerTwinSys
-!* Shortened notation
-myInstance = phase_plasticityInstance(material_phase(ipc,ip,el))
-MyStructure = constitutive_titanmod_structure(myInstance)
-ns = constitutive_titanmod_totalNslip(myInstance)
-nt = constitutive_titanmod_totalNtwin(myInstance)
+!--------------------------------------------------------------------------------------------------
+! shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_titanmod_structure(matID)
+ ns = constitutive_titanmod_totalNslip(matID)
+ nt = constitutive_titanmod_totalNtwin(matID)
do i=1_pInt,nt
volumefraction_PerTwinSys(i)=state(ipc,ip,el)%p(3_pInt*ns+i)/ &
- constitutive_titanmod_twinshearconstant_PerTwinSys(i,myInstance)
+ constitutive_titanmod_twinshearconstant_PerTwinSys(i,matID)
enddo
@@ -1595,51 +1644,44 @@ sumf = sum(abs(volumefraction_PerTwinSys(1_pInt:nt))) ! safe for nt == 0
constitutive_titanmod_dotState = 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,myStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_titanmod_Nslip(f,myInstance) ! process each (active) slip system in family
+ slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily
+ index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_titanmod_Nslip(f,matID) ! process each (active) slip system in family
j = j+1_pInt
- !* Multiplication of edge dislocations
- DotRhoEdgeGeneration(j) = (state(ipc,ip,el)%p(ns+j)*state(ipc,ip,el)%p(8*ns+2*nt+j)/state(ipc,ip,el)%p(4*ns+nt+j))
- !* Multiplication of screw dislocations
- DotRhoScrewGeneration(j) = (state(ipc,ip,el)%p(j)*state(ipc,ip,el)%p(7*ns+2*nt+j)/state(ipc,ip,el)%p(3*ns+nt+j))
-
- !* Annihilation of edge dislocations
- DotRhoEdgeAnnihilation(j) = -((state(ipc,ip,el)%p(j))**2)* &
- constitutive_titanmod_capre_PerSlipSys(j,myInstance)*state(ipc,ip,el)%p(7*ns+2*nt+j)/2.0_pReal
-
- !* Annihilation of screw dislocations
- DotRhoScrewAnnihilation(j) = -((state(ipc,ip,el)%p(ns+j))**2)* &
- constitutive_titanmod_caprs_PerSlipSys(j,myInstance)*state(ipc,ip,el)%p(8*ns+2*nt+j)/2.0_pReal
-
- !* Edge dislocation density rate of change
- constitutive_titanmod_dotState(j) = &
+ DotRhoEdgeGeneration(j) = & ! multiplication of edge dislocations
+ state(ipc,ip,el)%p(ns+j)*state(ipc,ip,el)%p(8*ns+2*nt+j)/state(ipc,ip,el)%p(4*ns+nt+j)
+ DotRhoScrewGeneration(j) = & ! multiplication of screw dislocations
+ state(ipc,ip,el)%p(j)*state(ipc,ip,el)%p(7*ns+2*nt+j)/state(ipc,ip,el)%p(3*ns+nt+j)
+ DotRhoEdgeAnnihilation(j) = -((state(ipc,ip,el)%p(j))**2)* & ! annihilation of edge dislocations
+ constitutive_titanmod_capre_PerSlipSys(j,matID)*state(ipc,ip,el)%p(7*ns+2*nt+j)*0.5_pReal
+ DotRhoScrewAnnihilation(j) = -((state(ipc,ip,el)%p(ns+j))**2)* & ! annihilation of screw dislocations
+ constitutive_titanmod_caprs_PerSlipSys(j,matID)*state(ipc,ip,el)%p(8*ns+2*nt+j)*0.5_pReal
+ constitutive_titanmod_dotState(j) = & ! edge dislocation density rate of change
DotRhoEdgeGeneration(j)+DotRhoEdgeAnnihilation(j)
- !* Screw dislocation density rate of change
- constitutive_titanmod_dotState(ns+j) = &
+ constitutive_titanmod_dotState(ns+j) = & ! screw dislocation density rate of change
DotRhoScrewGeneration(j)+DotRhoScrewAnnihilation(j)
- constitutive_titanmod_dotState(2*ns+j) = &
- state(ipc,ip,el)%p(10*ns+2*nt+j)+state(ipc,ip,el)%p(11*ns+2*nt+j) ! sum of shear due to edge and screw
+ constitutive_titanmod_dotState(2*ns+j) = & ! sum of shear due to edge and screw
+ state(ipc,ip,el)%p(10*ns+2*nt+j)+state(ipc,ip,el)%p(11*ns+2*nt+j)
enddo
- enddo
+ enddo slipFamiliesLoop
!* Twin fraction evolution
j = 0_pInt
-do f = 1_pInt,lattice_maxNtwinFamily ! loop over all twin families
- index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,MyStructure)) ! at which index starts my family
- do i = 1_pInt,constitutive_titanmod_Ntwin(f,myInstance) ! process each (active) twin system in family
+ twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily
+ index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family
+ do i = 1_pInt,constitutive_titanmod_Ntwin(f,matID) ! 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,myStructure))
+ tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,structID))
!* Stress ratio for edge
twinStressRatio_p = ((abs(tau_twin(j)))/ &
- ( constitutive_titanmod_twintau0_PerTwinSys(j,myInstance)+state(ipc,ip,el)%p(7*ns+nt+j)) &
- )**(constitutive_titanmod_twinp_PerTwinSys(j,myInstance))
+ ( constitutive_titanmod_twintau0_PerTwinSys(j,matID)+state(ipc,ip,el)%p(7*ns+nt+j)) &
+ )**(constitutive_titanmod_twinp_PerTwinSys(j,matID))
if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then
@@ -1648,17 +1690,16 @@ do f = 1_pInt,lattice_maxNtwinFamily ! loop over
twinminusStressRatio_p=0.001_pReal
endif
- !* Boltzmann ratio
- BoltzmannRatio = constitutive_titanmod_twinf0_PerTwinSys(j,myInstance)/(kB*Temperature)
+ BoltzmannRatio = constitutive_titanmod_twinf0_PerTwinSys(j,matID)/(kB*Temperature)
- gdot_twin(j) =constitutive_titanmod_twingamma0_PerTwinSys(j,myInstance)*exp(-BoltzmannRatio* &
+ gdot_twin(j) =constitutive_titanmod_twingamma0_PerTwinSys(j,matID)*exp(-BoltzmannRatio* &
(twinminusStressRatio_p)** &
- constitutive_titanmod_twinq_PerTwinSys(j,myInstance))*sign(1.0_pReal,tau_twin(j))
+ constitutive_titanmod_twinq_PerTwinSys(j,matID))*sign(1.0_pReal,tau_twin(j))
constitutive_titanmod_dotState(3*ns+j)=gdot_twin(j)
enddo
- enddo
+ enddo twinFamiliesLoop
end function constitutive_titanmod_dotState
@@ -1732,42 +1773,61 @@ end function constitutive_titanmod_dotTemperature
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
pure function constitutive_titanmod_postResults(Tstar_v,Temperature,dt,state,ipc,ip,el)
- use prec, only: pReal,pInt,p_vec
- use mesh, only: mesh_NcpElems,mesh_maxNips
- use material, only: homogenization_maxNgrains,material_phase,phase_plasticityInstance,phase_Noutput
+ use prec, only: &
+ p_vec
+ use mesh, only: &
+ mesh_NcpElems, &
+ mesh_maxNips
+ use material, only: &
+ homogenization_maxNgrains, &
+ material_phase, &
+ phase_plasticityInstance, &
+ phase_Noutput
implicit none
- integer(pInt), intent(in) :: ipc,ip,el
- real(pReal), intent(in) :: dt,Temperature
- real(pReal), dimension(6), intent(in) :: Tstar_v
- type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: state
- integer(pInt) myInstance,myStructure,ns,nt,o,i,c
- real(pReal) sumf
+ real(pReal), dimension(6), intent(in) :: &
+ Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+ real(pReal), intent(in) :: &
+ temperature, & !< temperature at integration point
+ dt
+ integer(pInt), intent(in) :: &
+ ipc, & !< component-ID of integration point
+ ip, & !< integration point
+ el !< element
+ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
+ state !< microstructure state
+ integer(pInt) :: &
+ matID, structID,&
+ ns,nt,&
+ o,i,c
+ real(pReal) :: sumf
real(pReal), dimension(constitutive_titanmod_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
constitutive_titanmod_postResults
real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
volumefraction_PerTwinSys
- !* Shortened notation
- myInstance = phase_plasticityInstance(material_phase(ipc,ip,el))
- myStructure = constitutive_titanmod_structure(myInstance)
- ns = constitutive_titanmod_totalNslip(myInstance)
- nt = constitutive_titanmod_totalNtwin(myInstance)
+!--------------------------------------------------------------------------------------------------
+! shortened notation
+ matID = phase_plasticityInstance(material_phase(ipc,ip,el))
+ structID = constitutive_titanmod_structure(matID)
+ ns = constitutive_titanmod_totalNslip(matID)
+ nt = constitutive_titanmod_totalNtwin(matID)
do i=1_pInt,nt
volumefraction_PerTwinSys(i)=state(ipc,ip,el)%p(3_pInt*ns+i)/ &
- constitutive_titanmod_twinshearconstant_PerTwinSys(i,myInstance)
+ constitutive_titanmod_twinshearconstant_PerTwinSys(i,matID)
enddo
sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0
- !* Required output
+!--------------------------------------------------------------------------------------------------
+! required output
c = 0_pInt
constitutive_titanmod_postResults = 0.0_pReal
do o = 1_pInt,phase_Noutput(material_phase(ipc,ip,el))
- select case(constitutive_titanmod_output(o,myInstance))
+ select case(constitutive_titanmod_output(o,matID))
case ('rhoedge')
constitutive_titanmod_postResults(c+1_pInt:c+ns) = state(ipc,ip,el)%p(1_pInt:ns)
c = c + ns