From 82faf743639d0895962770e8fe8931d1ff703042 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 8 Oct 2013 16:27:26 +0000 Subject: [PATCH] added doxygen documentation and unified variable names and some common parts of the code --- code/constitutive_dislotwin.f90 | 3590 ++++++++++++++------------- code/constitutive_j2.f90 | 26 +- code/constitutive_none.f90 | 12 +- code/constitutive_nonlocal.f90 | 2 +- code/constitutive_phenopowerlaw.f90 | 129 +- code/constitutive_titanmod.f90 | 786 +++--- 6 files changed, 2342 insertions(+), 2203 deletions(-) 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