diff --git a/CMakeLists.txt b/CMakeLists.txt index e69de29bb..4a2af196d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -0,0 +1,56 @@ +# Initial attempt of using CMake to build the spectral solver +# --> CMake should be able to take care of the dependence by itself. +# +cmake_minimum_required (VERSION 3.1.0) +project (DAMASKSpectral Fortran) + + +# make sure that the default is a RELEASE +if (NOT CMAKE_BUILD_TYPE) + set (CMAKE_BUILD_TYPE RELEASE CACHE STRING + "Choose the type of build, options are: None Debug Release." + FORCE) +endif (NOT CMAKE_BUILD_TYPE) + + +# The version number. +set (DAMASKSpectral_VERSION_MAJOR 1) +set (DAMASKSpectral_VERSION_MINOR 0) + +# Set up build directory +set (CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/build) +set (CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/lib) +set (CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/lib) + + +# setup modules +find_package(petsc) +find_package(hdf5) + +# FFLAGS depend on the compiler +# need extra time to work on these +get_filename_component (Fortran_COMPILER_NAME ${CMAKE_Fortran_COMPILER} NAME) + +if (Fortran_COMPILER_NAME MATCHES "gfortran.*") + # gfortran + set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3") + set (CMAKE_Fortran_FLAGS_DEBUG "-fno-f2c -O0 -g") +elseif (Fortran_COMPILER_NAME MATCHES "ifort.*") + # ifort (untested) + set (CMAKE_Fortran_FLAGS_RELEASE "-f77rtl -O3") + set (CMAKE_Fortran_FLAGS_DEBUG "-f77rtl -O0 -g") +elseif (Fortran_COMPILER_NAME MATCHES "g77") + # g77 + set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3 -m32") + set (CMAKE_Fortran_FLAGS_DEBUG "-fno-f2c -O0 -g -m32") +else (Fortran_COMPILER_NAME MATCHES "gfortran.*") + message ("CMAKE_Fortran_COMPILER full path: " ${CMAKE_Fortran_COMPILER}) + message ("Fortran compiler: " ${Fortran_COMPILER_NAME}) + message ("No optimized Fortran compiler flags are known, we just try -O2...") + set (CMAKE_Fortran_FLAGS_RELEASE "-O2") + set (CMAKE_Fortran_FLAGS_DEBUG "-O0 -g") +endif (Fortran_COMPILER_NAME MATCHES "gfortran.*") + + +# add code(source) directory +add_subdirectory(code) \ No newline at end of file diff --git a/code/CMakeLists.txt b/code/CMakeLists.txt new file mode 100644 index 000000000..742d7e146 --- /dev/null +++ b/code/CMakeLists.txt @@ -0,0 +1,41 @@ +# group sources for base modules +set (SRC "CPFEM" + "CPFEM2" + "core_quit" + "commercialFEM_fileList" + "compilation_info" + "constitutive" + "crystallite" + "damask_hdf5.f90" + "debug" + "FEsolving" + "IO" + "lattice" + "libs" + "material" + "math" + "mesh" + "numerics" + "prec" + "quit__genmod" + ) + +# compiler base modules +foreach (p ${SRC}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) + +# compile each sub moudel +add_subdirectory(damage) +add_subdirectory(homogenization) +add_subdirectory(hydrogenflux) +add_subdirectory(kinematics) +add_subdirectory(plastic) +add_subdirectory(porosity) +add_subdirectory(sources) +add_subdirectory(spectral) +add_subdirectory(thermal) +add_subdirectory(vacancyflux) + +# compile spectral solver +add_executable(DAMASKSpectral.exe DAMASK_spectral.f90) diff --git a/code/damage/CMakeLists.txt b/code/damage/CMakeLists.txt new file mode 100644 index 000000000..483baba57 --- /dev/null +++ b/code/damage/CMakeLists.txt @@ -0,0 +1,10 @@ +# group sources +set (DAMAGE "damage_none" + "damage_local" + "damage_nonlocal" + ) + +# compile damage module +foreach (p ${DAMAGE}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) diff --git a/code/damage/damage_local.f90 b/code/damage/damage_local.f90 new file mode 100644 index 000000000..196382c13 --- /dev/null +++ b/code/damage/damage_local.f90 @@ -0,0 +1,327 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for locally evolving damage field +!-------------------------------------------------------------------------------------------------- +module damage_local + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + damage_local_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + damage_local_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + damage_local_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + damage_local_Noutput !< number of outputs per instance of this damage + + enum, bind(c) + enumerator :: undefined_ID, & + damage_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + damage_local_outputID !< ID of each post result output + + public :: & + damage_local_init, & + damage_local_updateState, & + damage_local_postResults + private :: & + damage_local_getSourceAndItsTangent + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, reads information from material configuration file +!-------------------------------------------------------------------------------------------------- +subroutine damage_local_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + damage_type, & + damage_typeInstance, & + homogenization_Noutput, & + DAMAGE_local_label, & + DAMAGE_local_ID, & + material_homog, & + mappingHomogenization, & + damageState, & + damageMapping, & + damage, & + damage_initialPhi, & + material_partHomogenization + use numerics,only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,homog,instance,o + integer(pInt) :: sizeState + integer(pInt) :: NofMyHomog + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) + if (maxNinstance == 0_pInt) return + + allocate(damage_local_sizePostResults(maxNinstance), source=0_pInt) + allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance)) + damage_local_output = '' + allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) + allocate(damage_local_Noutput (maxNinstance), source=0_pInt) + + rewind(fileUnit) + homog = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next homog section + homog = homog + 1_pInt ! advance homog section counter + cycle ! skip to next line + endif + + if (homog > 0_pInt ) then; if (damage_type(homog) == DAMAGE_local_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = damage_typeInstance(homog) ! which instance of my damage is present homog + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('damage') + damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1_pInt + damage_local_outputID(damage_local_Noutput(instance),instance) = damage_ID + damage_local_output(damage_local_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + end select + endif; endif + enddo parsingFile + + initializeInstances: do homog = 1_pInt, size(damage_type) + + myhomog: if (damage_type(homog) == DAMAGE_local_ID) then + NofMyHomog = count(material_homog == homog) + instance = damage_typeInstance(homog) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,damage_local_Noutput(instance) + select case(damage_local_outputID(o,instance)) + case(damage_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + damage_local_sizePostResult(o,instance) = mySize + damage_local_sizePostResults(instance) = damage_local_sizePostResults(instance) + mySize + endif + enddo outputsLoop + +! allocate state arrays + sizeState = 1_pInt + damageState(homog)%sizeState = sizeState + damageState(homog)%sizePostResults = damage_local_sizePostResults(instance) + allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog)) + + nullify(damageMapping(homog)%p) + damageMapping(homog)%p => mappingHomogenization(1,:,:) + deallocate(damage(homog)%p) + damage(homog)%p => damageState(homog)%state(1,:) + + endif myhomog + enddo initializeInstances + + +end subroutine damage_local_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates local change in damage field +!-------------------------------------------------------------------------------------------------- +function damage_local_updateState(subdt, ip, el) + use numerics, only: & + residualStiffness, & + err_damage_tolAbs, & + err_damage_tolRel + use material, only: & + mappingHomogenization, & + damageState + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + subdt + logical, dimension(2) :: & + damage_local_updateState + integer(pInt) :: & + homog, & + offset + real(pReal) :: & + phi, phiDot, dPhiDot_dPhi + + homog = mappingHomogenization(2,ip,el) + offset = mappingHomogenization(1,ip,el) + phi = damageState(homog)%subState0(1,offset) + call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) + phi = max(residualStiffness,min(1.0_pReal,phi + subdt*phiDot)) + + damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) & + <= err_damage_tolAbs & + .or. abs(phi - damageState(homog)%state(1,offset)) & + <= err_damage_tolRel*abs(damageState(homog)%state(1,offset)), & + .true.] + + damageState(homog)%state(1,offset) = phi + +end function damage_local_updateState + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates homogenized local damage driving forces +!-------------------------------------------------------------------------------------------------- +subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) + use material, only: & + homogenization_Ngrains, & + mappingHomogenization, & + phaseAt, phasememberAt, & + phase_source, & + phase_Nsources, & + SOURCE_damage_isoBrittle_ID, & + SOURCE_damage_isoDuctile_ID, & + SOURCE_damage_anisoBrittle_ID, & + SOURCE_damage_anisoDuctile_ID + use source_damage_isoBrittle, only: & + source_damage_isobrittle_getRateAndItsTangent + use source_damage_isoDuctile, only: & + source_damage_isoductile_getRateAndItsTangent + use source_damage_anisoBrittle, only: & + source_damage_anisobrittle_getRateAndItsTangent + use source_damage_anisoDuctile, only: & + source_damage_anisoductile_getRateAndItsTangent + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer(pInt) :: & + phase, & + grain, & + source + real(pReal) :: & + phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi + + phiDot = 0.0_pReal + dPhiDot_dPhi = 0.0_pReal + do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) + phase = phaseAt(grain,ip,el) + do source = 1, phase_Nsources(phase) + select case(phase_source(source,phase)) + case (SOURCE_damage_isoBrittle_ID) + call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case (SOURCE_damage_isoDuctile_ID) + call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case (SOURCE_damage_anisoBrittle_ID) + call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case (SOURCE_damage_anisoDuctile_ID) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case default + localphiDot = 0.0_pReal + dLocalphiDot_dPhi = 0.0_pReal + + end select + phiDot = phiDot + localphiDot + dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi + enddo + enddo + + phiDot = phiDot/homogenization_Ngrains(mappingHomogenization(2,ip,el)) + dPhiDot_dPhi = dPhiDot_dPhi/homogenization_Ngrains(mappingHomogenization(2,ip,el)) + +end subroutine damage_local_getSourceAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of damage results +!-------------------------------------------------------------------------------------------------- +function damage_local_postResults(ip,el) + use material, only: & + mappingHomogenization, & + damage_typeInstance, & + damageMapping, & + damage + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element + real(pReal), dimension(damage_local_sizePostResults(damage_typeInstance(mappingHomogenization(2,ip,el)))) :: & + damage_local_postResults + + integer(pInt) :: & + instance, homog, offset, o, c + + homog = mappingHomogenization(2,ip,el) + offset = damageMapping(homog)%p(ip,el) + instance = damage_typeInstance(homog) + + c = 0_pInt + damage_local_postResults = 0.0_pReal + + do o = 1_pInt,damage_local_Noutput(instance) + select case(damage_local_outputID(o,instance)) + + case (damage_ID) + damage_local_postResults(c+1_pInt) = damage(homog)%p(offset) + c = c + 1 + end select + enddo +end function damage_local_postResults + +end module damage_local diff --git a/code/damage/damage_none.f90 b/code/damage/damage_none.f90 new file mode 100644 index 000000000..956ba5cc8 --- /dev/null +++ b/code/damage/damage_none.f90 @@ -0,0 +1,60 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for constant damage field +!-------------------------------------------------------------------------------------------------- +module damage_none + + implicit none + private + + public :: & + damage_none_init + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, reads information from material configuration file +!-------------------------------------------------------------------------------------------------- +subroutine damage_none_init() + 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 + use IO, only: & + IO_timeStamp + use material + use numerics, only: & + worldrank + + implicit none + integer(pInt) :: & + homog, & + NofMyHomog + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + initializeInstances: do homog = 1_pInt, material_Nhomogenization + + myhomog: if (damage_type(homog) == DAMAGE_none_ID) then + NofMyHomog = count(material_homog == homog) + damageState(homog)%sizeState = 0_pInt + damageState(homog)%sizePostResults = 0_pInt + allocate(damageState(homog)%state0 (0_pInt,NofMyHomog)) + allocate(damageState(homog)%subState0(0_pInt,NofMyHomog)) + allocate(damageState(homog)%state (0_pInt,NofMyHomog)) + + deallocate(damage(homog)%p) + allocate (damage(homog)%p(1), source=damage_initialPhi(homog)) + + endif myhomog + enddo initializeInstances + + +end subroutine damage_none_init + +end module damage_none diff --git a/code/damage/damage_nonlocal.f90 b/code/damage/damage_nonlocal.f90 new file mode 100644 index 000000000..311570781 --- /dev/null +++ b/code/damage/damage_nonlocal.f90 @@ -0,0 +1,380 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for non-locally evolving damage field +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module damage_nonlocal + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + damage_nonlocal_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + damage_nonlocal_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + damage_nonlocal_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + damage_nonlocal_Noutput !< number of outputs per instance of this damage + + enum, bind(c) + enumerator :: undefined_ID, & + damage_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + damage_nonlocal_outputID !< ID of each post result output + + + public :: & + damage_nonlocal_init, & + damage_nonlocal_getSourceAndItsTangent, & + damage_nonlocal_getDiffusion33, & + damage_nonlocal_getMobility, & + damage_nonlocal_putNonLocalDamage, & + damage_nonlocal_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine damage_nonlocal_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + damage_type, & + damage_typeInstance, & + homogenization_Noutput, & + DAMAGE_nonlocal_label, & + DAMAGE_nonlocal_ID, & + material_homog, & + mappingHomogenization, & + damageState, & + damageMapping, & + damage, & + damage_initialPhi, & + material_partHomogenization + use numerics,only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o + integer(pInt) :: sizeState + integer(pInt) :: NofMyHomog + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) + if (maxNinstance == 0_pInt) return + + allocate(damage_nonlocal_sizePostResults(maxNinstance), source=0_pInt) + allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) + damage_nonlocal_output = '' + allocate(damage_nonlocal_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) + allocate(damage_nonlocal_Noutput (maxNinstance), source=0_pInt) + + rewind(fileUnit) + section = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next homog section + section = section + 1_pInt ! advance homog section counter + cycle ! skip to next line + endif + + if (section > 0_pInt ) then; if (damage_type(section) == DAMAGE_nonlocal_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = damage_typeInstance(section) ! which instance of my damage is present homog + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('damage') + damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1_pInt + damage_nonlocal_outputID(damage_nonlocal_Noutput(instance),instance) = damage_ID + damage_nonlocal_output(damage_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + end select + endif; endif + enddo parsingFile + + initializeInstances: do section = 1_pInt, size(damage_type) + if (damage_type(section) == DAMAGE_nonlocal_ID) then + NofMyHomog=count(material_homog==section) + instance = damage_typeInstance(section) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,damage_nonlocal_Noutput(instance) + select case(damage_nonlocal_outputID(o,instance)) + case(damage_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + damage_nonlocal_sizePostResult(o,instance) = mySize + damage_nonlocal_sizePostResults(instance) = damage_nonlocal_sizePostResults(instance) + mySize + endif + enddo outputsLoop + +! allocate state arrays + sizeState = 0_pInt + damageState(section)%sizeState = sizeState + damageState(section)%sizePostResults = damage_nonlocal_sizePostResults(instance) + allocate(damageState(section)%state0 (sizeState,NofMyHomog)) + allocate(damageState(section)%subState0(sizeState,NofMyHomog)) + allocate(damageState(section)%state (sizeState,NofMyHomog)) + + nullify(damageMapping(section)%p) + damageMapping(section)%p => mappingHomogenization(1,:,:) + deallocate(damage(section)%p) + allocate(damage(section)%p(NofMyHomog), source=damage_initialPhi(section)) + + endif + + enddo initializeInstances +end subroutine damage_nonlocal_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates homogenized damage driving forces +!-------------------------------------------------------------------------------------------------- +subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) + use material, only: & + homogenization_Ngrains, & + mappingHomogenization, & + phaseAt, phasememberAt, & + phase_source, & + phase_Nsources, & + SOURCE_damage_isoBrittle_ID, & + SOURCE_damage_isoDuctile_ID, & + SOURCE_damage_anisoBrittle_ID, & + SOURCE_damage_anisoDuctile_ID + use source_damage_isoBrittle, only: & + source_damage_isobrittle_getRateAndItsTangent + use source_damage_isoDuctile, only: & + source_damage_isoductile_getRateAndItsTangent + use source_damage_anisoBrittle, only: & + source_damage_anisobrittle_getRateAndItsTangent + use source_damage_anisoDuctile, only: & + source_damage_anisoductile_getRateAndItsTangent + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer(pInt) :: & + phase, & + grain, & + source + real(pReal) :: & + phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi + + phiDot = 0.0_pReal + dPhiDot_dPhi = 0.0_pReal + do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) + phase = phaseAt(grain,ip,el) + do source = 1_pInt, phase_Nsources(phase) + select case(phase_source(source,phase)) + case (SOURCE_damage_isoBrittle_ID) + call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case (SOURCE_damage_isoDuctile_ID) + call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case (SOURCE_damage_anisoBrittle_ID) + call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case (SOURCE_damage_anisoDuctile_ID) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + + case default + localphiDot = 0.0_pReal + dLocalphiDot_dPhi = 0.0_pReal + + end select + phiDot = phiDot + localphiDot + dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi + enddo + enddo + + phiDot = phiDot/homogenization_Ngrains(mappingHomogenization(2,ip,el)) + dPhiDot_dPhi = dPhiDot_dPhi/homogenization_Ngrains(mappingHomogenization(2,ip,el)) + +end subroutine damage_nonlocal_getSourceAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized non local damage diffusion tensor in reference configuration +!-------------------------------------------------------------------------------------------------- +function damage_nonlocal_getDiffusion33(ip,el) + use numerics, only: & + charLength + use lattice, only: & + lattice_DamageDiffusion33 + use material, only: & + homogenization_Ngrains, & + material_phase, & + mappingHomogenization + use crystallite, only: & + crystallite_push33ToRef + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + damage_nonlocal_getDiffusion33 + integer(pInt) :: & + homog, & + grain + + homog = mappingHomogenization(2,ip,el) + damage_nonlocal_getDiffusion33 = 0.0_pReal + do grain = 1, homogenization_Ngrains(homog) + damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + & + crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el))) + enddo + + damage_nonlocal_getDiffusion33 = & + charLength*charLength* & + damage_nonlocal_getDiffusion33/ & + homogenization_Ngrains(homog) + +end function damage_nonlocal_getDiffusion33 + +!-------------------------------------------------------------------------------------------------- +!> @brief Returns homogenized nonlocal damage mobility +!-------------------------------------------------------------------------------------------------- +real(pReal) function damage_nonlocal_getMobility(ip,el) + use mesh, only: & + mesh_element + use lattice, only: & + lattice_damageMobility + use material, only: & + material_phase, & + homogenization_Ngrains + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + integer(pInt) :: & + ipc + + damage_nonlocal_getMobility = 0.0_pReal + + do ipc = 1, homogenization_Ngrains(mesh_element(3,el)) + damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el)) + enddo + + damage_nonlocal_getMobility = damage_nonlocal_getMobility /homogenization_Ngrains(mesh_element(3,el)) + +end function damage_nonlocal_getMobility + +!-------------------------------------------------------------------------------------------------- +!> @brief updated nonlocal damage field with solution from damage phase field PDE +!-------------------------------------------------------------------------------------------------- +subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) + use material, only: & + material_homog, & + damageMapping, & + damage + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer(pInt) :: & + homog, & + offset + + homog = material_homog(ip,el) + offset = damageMapping(homog)%p(ip,el) + damage(homog)%p(offset) = phi + +end subroutine damage_nonlocal_putNonLocalDamage + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of damage results +!-------------------------------------------------------------------------------------------------- +function damage_nonlocal_postResults(ip,el) + use material, only: & + mappingHomogenization, & + damage_typeInstance, & + damage + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element + real(pReal), dimension(damage_nonlocal_sizePostResults(damage_typeInstance(mappingHomogenization(2,ip,el)))) :: & + damage_nonlocal_postResults + + integer(pInt) :: & + instance, homog, offset, o, c + + homog = mappingHomogenization(2,ip,el) + offset = mappingHomogenization(1,ip,el) + instance = damage_typeInstance(homog) + + c = 0_pInt + damage_nonlocal_postResults = 0.0_pReal + + do o = 1_pInt,damage_nonlocal_Noutput(instance) + select case(damage_nonlocal_outputID(o,instance)) + + case (damage_ID) + damage_nonlocal_postResults(c+1_pInt) = damage(homog)%p(offset) + c = c + 1 + end select + enddo +end function damage_nonlocal_postResults + +end module damage_nonlocal diff --git a/code/homogenization/CMakeLists.txt b/code/homogenization/CMakeLists.txt new file mode 100644 index 000000000..84555e333 --- /dev/null +++ b/code/homogenization/CMakeLists.txt @@ -0,0 +1,11 @@ +# group sources +set (HOMOGENIZATION "homogenization" + "homogenization_RGC" + "homogenization_isostrain" + "homogenization_none" + ) + +# compile modules +foreach (p ${HOMOGENIZATION}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) diff --git a/code/homogenization/homogenization.f90 b/code/homogenization/homogenization.f90 new file mode 100644 index 000000000..00186ff06 --- /dev/null +++ b/code/homogenization/homogenization.f90 @@ -0,0 +1,1396 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH +!> @brief homogenization manager, organizing deformation partitioning and stress homogenization +!-------------------------------------------------------------------------------------------------- +module homogenization + use prec, only: & +#ifdef FEM + tOutputData, & +#endif + pInt, & + pReal + +!-------------------------------------------------------------------------------------------------- +! General variables for the homogenization at a material point + implicit none + private + real(pReal), dimension(:,:,:,:), allocatable, public :: & + materialpoint_F0, & !< def grad of IP at start of FE increment + materialpoint_F, & !< def grad of IP to be reached at end of FE increment + materialpoint_P !< first P--K stress of IP + real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & + materialpoint_dPdF !< tangent of first P--K stress at IP +#ifdef FEM + type(tOutputData), dimension(:), allocatable, public :: & + homogOutput + type(tOutputData), dimension(:,:), allocatable, public :: & + crystalliteOutput, & + phaseOutput +#else + real(pReal), dimension(:,:,:), allocatable, public :: & + materialpoint_results !< results array of material point +#endif + integer(pInt), public, protected :: & + materialpoint_sizeResults, & + homogenization_maxSizePostResults, & + thermal_maxSizePostResults, & + damage_maxSizePostResults, & + vacancyflux_maxSizePostResults, & + porosity_maxSizePostResults, & + hydrogenflux_maxSizePostResults + + real(pReal), dimension(:,:,:,:), allocatable, private :: & + materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment + materialpoint_subF !< def grad of IP to be reached at end of homog inc + real(pReal), dimension(:,:), allocatable, private :: & + materialpoint_subFrac, & + materialpoint_subStep, & + materialpoint_subdt + logical, dimension(:,:), allocatable, private :: & + materialpoint_requested, & + materialpoint_converged + logical, dimension(:,:,:), allocatable, private :: & + materialpoint_doneAndHappy + + public :: & + homogenization_init, & + materialpoint_stressAndItsTangent, & + materialpoint_postResults + private :: & + homogenization_partitionDeformation, & + homogenization_updateState, & + homogenization_averageStressAndItsTangent, & + homogenization_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_init +#ifdef HDF + use hdf5, only: & + HID_T + use IO, only : & + HDF5_mappingHomogenization +#endif + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use math, only: & + math_I3 + use debug, only: & + debug_level, & + debug_homogenization, & + debug_levelBasic, & + debug_e, & + debug_g + use mesh, only: & + mesh_maxNips, & + mesh_NcpElems, & + mesh_element, & + FE_Nips, & + FE_geomtype +#ifdef FEM + use crystallite, only: & + crystallite_sizePostResults +#else + use constitutive, only: & + constitutive_plasticity_maxSizePostResults, & + constitutive_source_maxSizePostResults + use crystallite, only: & + crystallite_maxSizePostResults +#endif + use material + use homogenization_none + use homogenization_isostrain + use homogenization_RGC + use thermal_isothermal + use thermal_adiabatic + use thermal_conduction + use damage_none + use damage_local + use damage_nonlocal + use vacancyflux_isoconc + use vacancyflux_isochempot + use vacancyflux_cahnhilliard + use porosity_none + use porosity_phasefield + use hydrogenflux_isoconc + use hydrogenflux_cahnhilliard + use IO + use numerics, only: & + worldrank + + implicit none + integer(pInt), parameter :: FILEUNIT = 200_pInt + integer(pInt) :: e,i,p + integer(pInt), dimension(:,:), pointer :: thisSize + integer(pInt), dimension(:) , pointer :: thisNoutput + character(len=64), dimension(:,:), pointer :: thisOutput + character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready + logical :: knownHomogenization, knownThermal, knownDamage, knownVacancyflux, knownPorosity, knownHydrogenflux +#ifdef HDF + integer(pInt), dimension(:,:), allocatable :: mapping + integer(pInt), dimension(:), allocatable :: InstancePosition + allocate(mapping(mesh_ncpelems,4),source=0_pInt) + allocate(InstancePosition(material_Nhomogenization),source=0_pInt) +#endif + + +!-------------------------------------------------------------------------------------------------- +! open material.config + if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... + call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file + +!-------------------------------------------------------------------------------------------------- +! parse homogenization from config file + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) & + call homogenization_none_init() + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) & + call homogenization_isostrain_init(FILEUNIT) + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) & + call homogenization_RGC_init(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! parse thermal from config file + call IO_checkAndRewind(FILEUNIT) + if (any(thermal_type == THERMAL_isothermal_ID)) & + call thermal_isothermal_init() + if (any(thermal_type == THERMAL_adiabatic_ID)) & + call thermal_adiabatic_init(FILEUNIT) + if (any(thermal_type == THERMAL_conduction_ID)) & + call thermal_conduction_init(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! parse damage from config file + call IO_checkAndRewind(FILEUNIT) + if (any(damage_type == DAMAGE_none_ID)) & + call damage_none_init() + if (any(damage_type == DAMAGE_local_ID)) & + call damage_local_init(FILEUNIT) + if (any(damage_type == DAMAGE_nonlocal_ID)) & + call damage_nonlocal_init(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! parse vacancy transport from config file + call IO_checkAndRewind(FILEUNIT) + if (any(vacancyflux_type == VACANCYFLUX_isoconc_ID)) & + call vacancyflux_isoconc_init() + if (any(vacancyflux_type == VACANCYFLUX_isochempot_ID)) & + call vacancyflux_isochempot_init(FILEUNIT) + if (any(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID)) & + call vacancyflux_cahnhilliard_init(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! parse porosity from config file + call IO_checkAndRewind(FILEUNIT) + if (any(porosity_type == POROSITY_none_ID)) & + call porosity_none_init() + if (any(porosity_type == POROSITY_phasefield_ID)) & + call porosity_phasefield_init(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! parse hydrogen transport from config file + call IO_checkAndRewind(FILEUNIT) + if (any(hydrogenflux_type == HYDROGENFLUX_isoconc_ID)) & + call hydrogenflux_isoconc_init() + if (any(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID)) & + call hydrogenflux_cahnhilliard_init(FILEUNIT) + close(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! write description file for homogenization output + mainProcess2: if (worldrank == 0) then + call IO_write_jobFile(FILEUNIT,'outputHomogenization') + do p = 1,material_Nhomogenization + if (any(material_homog == p)) then + i = homogenization_typeInstance(p) ! which instance of this homogenization type + knownHomogenization = .true. ! assume valid + select case(homogenization_type(p)) ! split per homogenization type + case (HOMOGENIZATION_NONE_ID) + outputName = HOMOGENIZATION_NONE_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (HOMOGENIZATION_ISOSTRAIN_ID) + outputName = HOMOGENIZATION_ISOSTRAIN_label + thisNoutput => homogenization_isostrain_Noutput + thisOutput => homogenization_isostrain_output + thisSize => homogenization_isostrain_sizePostResult + case (HOMOGENIZATION_RGC_ID) + outputName = HOMOGENIZATION_RGC_label + thisNoutput => homogenization_RGC_Noutput + thisOutput => homogenization_RGC_output + thisSize => homogenization_RGC_sizePostResult + case default + knownHomogenization = .false. + end select + write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']' + if (knownHomogenization) then + write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName) + write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) + if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + i = thermal_typeInstance(p) ! which instance of this thermal type + knownThermal = .true. ! assume valid + select case(thermal_type(p)) ! split per thermal type + case (THERMAL_isothermal_ID) + outputName = THERMAL_isothermal_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (THERMAL_adiabatic_ID) + outputName = THERMAL_adiabatic_label + thisNoutput => thermal_adiabatic_Noutput + thisOutput => thermal_adiabatic_output + thisSize => thermal_adiabatic_sizePostResult + case (THERMAL_conduction_ID) + outputName = THERMAL_conduction_label + thisNoutput => thermal_conduction_Noutput + thisOutput => thermal_conduction_output + thisSize => thermal_conduction_sizePostResult + case default + knownThermal = .false. + end select + if (knownThermal) then + write(FILEUNIT,'(a)') '(thermal)'//char(9)//trim(outputName) + if (thermal_type(p) /= THERMAL_isothermal_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + i = damage_typeInstance(p) ! which instance of this damage type + knownDamage = .true. ! assume valid + select case(damage_type(p)) ! split per damage type + case (DAMAGE_none_ID) + outputName = DAMAGE_none_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (DAMAGE_local_ID) + outputName = DAMAGE_local_label + thisNoutput => damage_local_Noutput + thisOutput => damage_local_output + thisSize => damage_local_sizePostResult + case (DAMAGE_nonlocal_ID) + outputName = DAMAGE_nonlocal_label + thisNoutput => damage_nonlocal_Noutput + thisOutput => damage_nonlocal_output + thisSize => damage_nonlocal_sizePostResult + case default + knownDamage = .false. + end select + if (knownDamage) then + write(FILEUNIT,'(a)') '(damage)'//char(9)//trim(outputName) + if (damage_type(p) /= DAMAGE_none_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + i = vacancyflux_typeInstance(p) ! which instance of this vacancy flux type + knownVacancyflux = .true. ! assume valid + select case(vacancyflux_type(p)) ! split per vacancy flux type + case (VACANCYFLUX_isoconc_ID) + outputName = VACANCYFLUX_isoconc_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (VACANCYFLUX_isochempot_ID) + outputName = VACANCYFLUX_isochempot_label + thisNoutput => vacancyflux_isochempot_Noutput + thisOutput => vacancyflux_isochempot_output + thisSize => vacancyflux_isochempot_sizePostResult + case (VACANCYFLUX_cahnhilliard_ID) + outputName = VACANCYFLUX_cahnhilliard_label + thisNoutput => vacancyflux_cahnhilliard_Noutput + thisOutput => vacancyflux_cahnhilliard_output + thisSize => vacancyflux_cahnhilliard_sizePostResult + case default + knownVacancyflux = .false. + end select + if (knownVacancyflux) then + write(FILEUNIT,'(a)') '(vacancyflux)'//char(9)//trim(outputName) + if (vacancyflux_type(p) /= VACANCYFLUX_isoconc_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + i = porosity_typeInstance(p) ! which instance of this porosity type + knownPorosity = .true. ! assume valid + select case(porosity_type(p)) ! split per porosity type + case (POROSITY_none_ID) + outputName = POROSITY_none_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (POROSITY_phasefield_ID) + outputName = POROSITY_phasefield_label + thisNoutput => porosity_phasefield_Noutput + thisOutput => porosity_phasefield_output + thisSize => porosity_phasefield_sizePostResult + case default + knownPorosity = .false. + end select + if (knownPorosity) then + write(FILEUNIT,'(a)') '(porosity)'//char(9)//trim(outputName) + if (porosity_type(p) /= POROSITY_none_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + i = hydrogenflux_typeInstance(p) ! which instance of this hydrogen flux type + knownHydrogenflux = .true. ! assume valid + select case(hydrogenflux_type(p)) ! split per hydrogen flux type + case (HYDROGENFLUX_isoconc_ID) + outputName = HYDROGENFLUX_isoconc_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (HYDROGENFLUX_cahnhilliard_ID) + outputName = HYDROGENFLUX_cahnhilliard_label + thisNoutput => hydrogenflux_cahnhilliard_Noutput + thisOutput => hydrogenflux_cahnhilliard_output + thisSize => hydrogenflux_cahnhilliard_sizePostResult + case default + knownHydrogenflux = .false. + end select + if (knownHydrogenflux) then + write(FILEUNIT,'(a)') '(hydrogenflux)'//char(9)//trim(outputName) + if (hydrogenflux_type(p) /= HYDROGENFLUX_isoconc_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + endif + enddo + close(FILEUNIT) + endif mainProcess2 + +!-------------------------------------------------------------------------------------------------- +! allocate and initialize global variables + allocate(materialpoint_dPdF(3,3,3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_F0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + materialpoint_F0 = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity + allocate(materialpoint_F(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + materialpoint_F = materialpoint_F0 ! initialize to identity + allocate(materialpoint_subF0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_subF(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_P(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_subFrac(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_subStep(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_subdt(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_requested(mesh_maxNips,mesh_NcpElems), source=.false.) + allocate(materialpoint_converged(mesh_maxNips,mesh_NcpElems), source=.true.) + allocate(materialpoint_doneAndHappy(2,mesh_maxNips,mesh_NcpElems), source=.true.) + +!-------------------------------------------------------------------------------------------------- +! allocate and initialize global state and postresutls variables +#ifdef HDF + elementLooping: do e = 1,mesh_NcpElems + myInstance = homogenization_typeInstance(mesh_element(3,e)) + IpLooping: do i = 1,FE_Nips(FE_geomtype(mesh_element(2,e))) + InstancePosition(myInstance) = InstancePosition(myInstance)+1_pInt + mapping(e,1:4) = [instancePosition(myinstance),myinstance,e,i] + enddo IpLooping + enddo elementLooping + call HDF5_mappingHomogenization(mapping) +#endif + + homogenization_maxSizePostResults = 0_pInt + thermal_maxSizePostResults = 0_pInt + damage_maxSizePostResults = 0_pInt + vacancyflux_maxSizePostResults = 0_pInt + porosity_maxSizePostResults = 0_pInt + hydrogenflux_maxSizePostResults = 0_pInt + do p = 1,material_Nhomogenization + homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults) + thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults) + damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults) + vacancyflux_maxSizePostResults = max(vacancyflux_maxSizePostResults ,vacancyfluxState (p)%sizePostResults) + porosity_maxSizePostResults = max(porosity_maxSizePostResults ,porosityState (p)%sizePostResults) + hydrogenflux_maxSizePostResults = max(hydrogenflux_maxSizePostResults ,hydrogenfluxState(p)%sizePostResults) + enddo + +#ifdef FEM + allocate(homogOutput (material_Nhomogenization )) + allocate(crystalliteOutput(material_Ncrystallite, homogenization_maxNgrains)) + allocate(phaseOutput (material_Nphase, homogenization_maxNgrains)) + do p = 1, material_Nhomogenization + homogOutput(p)%sizeResults = homogState (p)%sizePostResults + & + thermalState (p)%sizePostResults + & + damageState (p)%sizePostResults + & + vacancyfluxState (p)%sizePostResults + & + porosityState (p)%sizePostResults + & + hydrogenfluxState(p)%sizePostResults + homogOutput(p)%sizeIpCells = count(material_homog==p) + allocate(homogOutput(p)%output(homogOutput(p)%sizeResults,homogOutput(p)%sizeIpCells)) + enddo + do p = 1, material_Ncrystallite; do e = 1, homogenization_maxNgrains + crystalliteOutput(p,e)%sizeResults = crystallite_sizePostResults(p) + crystalliteOutput(p,e)%sizeIpCells = count(microstructure_crystallite(mesh_element(4,:)) == p .and. & + homogenization_Ngrains (mesh_element(3,:)) >= e)*mesh_maxNips + allocate(crystalliteOutput(p,e)%output(crystalliteOutput(p,e)%sizeResults,crystalliteOutput(p,e)%sizeIpCells)) + enddo; enddo + do p = 1, material_Nphase; do e = 1, homogenization_maxNgrains + phaseOutput(p,e)%sizeResults = plasticState (p)%sizePostResults + & + sum(sourceState (p)%p(:)%sizePostResults) + phaseOutput(p,e)%sizeIpCells = count(material_phase(e,:,:) == p) + allocate(phaseOutput(p,e)%output(phaseOutput(p,e)%sizeResults,phaseOutput(p,e)%sizeIpCells)) + enddo; enddo +#else + materialpoint_sizeResults = 1 & ! grain count + + 1 + homogenization_maxSizePostResults & ! homogSize & homogResult + + thermal_maxSizePostResults & + + damage_maxSizePostResults & + + vacancyflux_maxSizePostResults & + + porosity_maxSizePostResults & + + hydrogenflux_maxSizePostResults & + + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + + constitutive_source_maxSizePostResults) + allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) +#endif + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- homogenization init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then +#ifdef TODO + write(6,'(a32,1x,7(i8,1x))') 'homogenization_state0: ', shape(homogenization_state0) + write(6,'(a32,1x,7(i8,1x))') 'homogenization_subState0: ', shape(homogenization_subState0) + write(6,'(a32,1x,7(i8,1x))') 'homogenization_state: ', shape(homogenization_state) +#endif + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F0: ', shape(materialpoint_F0) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F: ', shape(materialpoint_F) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF0: ', shape(materialpoint_subF0) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF: ', shape(materialpoint_subF) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_P: ', shape(materialpoint_P) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subFrac: ', shape(materialpoint_subFrac) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subStep: ', shape(materialpoint_subStep) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subdt: ', shape(materialpoint_subdt) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged) + write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy) +#ifndef FEM + write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_results: ', shape(materialpoint_results) +#endif + write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', homogenization_maxSizePostResults + endif + flush(6) + + if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) & + call IO_error(602_pInt,ext_msg='component (grain)') + +end subroutine homogenization_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief parallelized calculation of stress and corresponding tangent at material points +!-------------------------------------------------------------------------------------------------- +subroutine materialpoint_stressAndItsTangent(updateJaco,dt) + use numerics, only: & + subStepMinHomog, & + subStepSizeHomog, & + stepIncreaseHomog, & + nHomog, & + nMPstate + use math, only: & + math_transpose33 + use FEsolving, only: & + FEsolving_execElem, & + FEsolving_execIP, & + terminallyIll + use mesh, only: & + mesh_element + use material, only: & + plasticState, & + sourceState, & + homogState, & + thermalState, & + damageState, & + vacancyfluxState, & + porosityState, & + hydrogenfluxState, & + phase_Nsources, & + mappingHomogenization, & + phaseAt, phasememberAt, & + homogenization_Ngrains + use crystallite, only: & + crystallite_F0, & + crystallite_Fp0, & + crystallite_Fp, & + crystallite_Fi0, & + crystallite_Fi, & + crystallite_Lp0, & + crystallite_Lp, & + crystallite_Li0, & + crystallite_Li, & + crystallite_dPdF, & + crystallite_dPdF0, & + crystallite_Tstar0_v, & + crystallite_Tstar_v, & + crystallite_partionedF0, & + crystallite_partionedF, & + crystallite_partionedFp0, & + crystallite_partionedLp0, & + crystallite_partionedFi0, & + crystallite_partionedLi0, & + crystallite_partioneddPdF0, & + crystallite_partionedTstar0_v, & + crystallite_dt, & + crystallite_requested, & + crystallite_converged, & + crystallite_stressAndItsTangent, & + crystallite_orientations + use debug, only: & + debug_level, & + debug_homogenization, & + debug_levelBasic, & + debug_levelSelective, & + debug_e, & + debug_i, & + debug_MaterialpointLoopDistribution, & + debug_MaterialpointStateLoopDistribution + + implicit none + real(pReal), intent(in) :: dt !< time increment + logical, intent(in) :: updateJaco !< initiating Jacobian update + integer(pInt) :: & + NiterationHomog, & + NiterationMPstate, & + g, & !< grain number + i, & !< integration point number + e, & !< element number + mySource, & + myNgrains + +!-------------------------------------------------------------------------------------------------- +! initialize to starting condition + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i + + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & + math_transpose33(materialpoint_F0(1:3,1:3,debug_i,debug_e)) + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & + math_transpose33(materialpoint_F(1:3,1:3,debug_i,debug_e)) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! initialize restoration points of ... + do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(mesh_element(3,e)) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do g = 1,myNgrains + + plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & + plasticState (phaseAt(g,i,e))%state0( :,phasememberAt(g,i,e)) + do mySource = 1_pInt, phase_Nsources(phaseAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & + sourceState(phaseAt(g,i,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) + enddo + + crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) ! ...plastic def grads + crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) ! ...plastic velocity grads + crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) ! ...intermediate def grads + crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) ! ...intermediate velocity grads + crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,g,i,e) = crystallite_dPdF0(1:3,1:3,1:3,1:3,g,i,e) ! ...stiffness + crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) ! ...def grads + crystallite_partionedTstar0_v(1:6,g,i,e) = crystallite_Tstar0_v(1:6,g,i,e) ! ...2nd PK stress + + enddo; enddo + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e)) + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) ! ...def grad + materialpoint_subFrac(i,e) = 0.0_pReal + materialpoint_subStep(i,e) = 1.0_pReal/subStepSizeHomog ! <> + materialpoint_converged(i,e) = .false. ! pretend failed step of twice the required size + materialpoint_requested(i,e) = .true. ! everybody requires calculation + endforall + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + vacancyfluxState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal vacancy transport state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + porosityState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal porosity state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + hydrogenfluxState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal hydrogen transport state + enddo + NiterationHomog = 0_pInt + + cutBackLooping: do while (.not. terminallyIll .and. & + any(materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMinHomog)) + + !$OMP PARALLEL DO PRIVATE(myNgrains) + elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(mesh_element(3,e)) + IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + + converged: if ( materialpoint_converged(i,e) ) then +#ifndef _OPENMP + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt & + .and. ((e == debug_e .and. i == debug_i) & + .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0_pInt)) then + write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & + materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', & + materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i + endif +#endif + +!--------------------------------------------------------------------------------------------------- +! calculate new subStep and new subFrac + materialpoint_subFrac(i,e) = materialpoint_subFrac(i,e) + materialpoint_subStep(i,e) + !$OMP FLUSH(materialpoint_subFrac) + materialpoint_subStep(i,e) = min(1.0_pReal-materialpoint_subFrac(i,e), & + stepIncreaseHomog*materialpoint_subStep(i,e)) ! introduce flexibility for step increase/acceleration + !$OMP FLUSH(materialpoint_subStep) + + steppingNeeded: if (materialpoint_subStep(i,e) > subStepMinHomog) then + + ! wind forward grain starting point of... + crystallite_partionedF0(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) ! ...def grads + + crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) = & + crystallite_Fp(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + + crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) = & + crystallite_Lp(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + + crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) = & + crystallite_Fi(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads + + crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) = & + crystallite_Li(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + + crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e) ! ...stiffness + + crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) = & + crystallite_Tstar_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress + + do g = 1,myNgrains + plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & + plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) + do mySource = 1_pInt, phase_Nsources(phaseAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & + sourceState(phaseAt(g,i,e))%p(mySource)%state( :,phasememberAt(g,i,e)) + enddo + enddo + + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + vacancyfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal vacancy transport state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + porosityState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal porosity state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & + hydrogenfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal hydrogen transport state + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad + !$OMP FLUSH(materialpoint_subF0) + elseif (materialpoint_requested(i,e)) then steppingNeeded ! already at final time (??) + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then + !$OMP CRITICAL (distributionHomog) + debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) = & + debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) + 1 + !$OMP END CRITICAL (distributionHomog) + endif + endif steppingNeeded + + else converged + if ( (myNgrains == 1_pInt .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + subStepSizeHomog * materialpoint_subStep(i,e) <= subStepMinHomog ) then ! would require too small subStep + ! cutback makes no sense + !$OMP FLUSH(terminallyIll) + if (.not. terminallyIll) then ! so first signals terminally ill... + !$OMP CRITICAL (write2out) + write(6,*) 'Integration point ', i,' at element ', e, ' terminally ill' + !$OMP END CRITICAL (write2out) + endif + !$OMP CRITICAL (setTerminallyIll) + terminallyIll = .true. ! ...and kills all others + !$OMP END CRITICAL (setTerminallyIll) + else ! cutback makes sense + materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback + !$OMP FLUSH(materialpoint_subStep) + +#ifndef _OPENMP + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt & + .and. ((e == debug_e .and. i == debug_i) & + .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0_pInt)) then + write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & + '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',& + materialpoint_subStep(i,e),' at el ip',e,i + endif +#endif + +!-------------------------------------------------------------------------------------------------- +! restore... + crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads + crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = & + crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) ! ...stiffness + crystallite_Tstar_v(1:6,1:myNgrains,i,e) = & + crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress + do g = 1, myNgrains + plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) = & + plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) + do mySource = 1_pInt, phase_Nsources(phaseAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(mySource)%state( :,phasememberAt(g,i,e)) = & + sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) + enddo + enddo + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + homogState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & + homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal homogenization state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + thermalState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & + thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & + damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + vacancyfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & + vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal vacancy transport state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + porosityState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & + porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal porosity state + forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & + hydrogenfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & + hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal hydrogen transport state + endif + endif converged + + if (materialpoint_subStep(i,e) > subStepMinHomog) then + materialpoint_requested(i,e) = .true. + materialpoint_subF(1:3,1:3,i,e) = materialpoint_subF0(1:3,1:3,i,e) + & + materialpoint_subStep(i,e) * (materialpoint_F(1:3,1:3,i,e) - materialpoint_F0(1:3,1:3,i,e)) + materialpoint_subdt(i,e) = materialpoint_subStep(i,e) * dt + materialpoint_doneAndHappy(1:2,i,e) = [.false.,.true.] + endif + enddo IpLooping1 + enddo elementLooping1 + !$OMP END PARALLEL DO + + NiterationMPstate = 0_pInt + + convergenceLooping: do while (.not. terminallyIll .and. & + any( materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) & + .and. .not. materialpoint_doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) & + ) .and. & + NiterationMPstate < nMPstate) + NiterationMPstate = NiterationMPstate + 1 + +!-------------------------------------------------------------------------------------------------- +! deformation partitioning +! based on materialpoint_subF0,.._subF,crystallite_partionedF0, and homogenization_state, +! results in crystallite_partionedF + !$OMP PARALLEL DO PRIVATE(myNgrains) + elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(mesh_element(3,e)) + IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + if ( materialpoint_requested(i,e) .and. & ! process requested but... + .not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points + call homogenization_partitionDeformation(i,e) ! partition deformation onto constituents + crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e) ! propagate materialpoint dt to grains + crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents + else + crystallite_requested(1:myNgrains,i,e) = .false. ! calculation for constituents not required anymore + endif + enddo IpLooping2 + enddo elementLooping2 + !$OMP END PARALLEL DO + +!-------------------------------------------------------------------------------------------------- +! crystallite integration +! based on crystallite_partionedF0,.._partionedF +! incrementing by crystallite_dt + call crystallite_stressAndItsTangent(updateJaco) ! request stress and tangent calculation for constituent grains + +!-------------------------------------------------------------------------------------------------- +! state update + !$OMP PARALLEL DO + elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) + IpLooping3: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + if ( materialpoint_requested(i,e) .and. & + .not. materialpoint_doneAndHappy(1,i,e)) then + if (.not. all(crystallite_converged(:,i,e))) then + materialpoint_doneAndHappy(1:2,i,e) = [.true.,.false.] + materialpoint_converged(i,e) = .false. + else + materialpoint_doneAndHappy(1:2,i,e) = homogenization_updateState(i,e) + materialpoint_converged(i,e) = all(materialpoint_doneAndHappy(1:2,i,e)) ! converged if done and happy + endif + !$OMP FLUSH(materialpoint_converged) + if (materialpoint_converged(i,e)) then + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then + !$OMP CRITICAL (distributionMPState) + debug_MaterialpointStateLoopdistribution(NiterationMPstate) = & + debug_MaterialpointStateLoopdistribution(NiterationMPstate) + 1_pInt + !$OMP END CRITICAL (distributionMPState) + endif + endif + endif + enddo IpLooping3 + enddo elementLooping3 + !$OMP END PARALLEL DO + + enddo convergenceLooping + + NiterationHomog = NiterationHomog + 1_pInt + + enddo cutBackLooping + + if (.not. terminallyIll ) then + call crystallite_orientations() ! calculate crystal orientations + !$OMP PARALLEL DO + elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) + IpLooping4: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + call homogenization_averageStressAndItsTangent(i,e) + enddo IpLooping4 + enddo elementLooping4 + !$OMP END PARALLEL DO + else + !$OMP CRITICAL (write2out) + write(6,'(/,a,/)') '<< HOMOG >> Material Point terminally ill' + !$OMP END CRITICAL (write2out) + endif + +end subroutine materialpoint_stressAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief parallelized calculation of result array at material points +!-------------------------------------------------------------------------------------------------- +subroutine materialpoint_postResults + use FEsolving, only: & + FEsolving_execElem, & + FEsolving_execIP + use mesh, only: & + mesh_element + use material, only: & + mappingHomogenization, & +#ifdef FEM + phaseAt, phasememberAt, & + homogenization_maxNgrains, & + material_Ncrystallite, & + material_Nphase, & +#else + homogState, & + thermalState, & + damageState, & + vacancyfluxState, & + porosityState, & + hydrogenfluxState, & +#endif + plasticState, & + sourceState, & + material_phase, & + homogenization_Ngrains, & + microstructure_crystallite + use constitutive, only: & +#ifdef FEM + constitutive_plasticity_maxSizePostResults, & + constitutive_source_maxSizePostResults, & +#endif + constitutive_postResults + use crystallite, only: & +#ifdef FEM + crystallite_maxSizePostResults, & +#endif + crystallite_sizePostResults, & + crystallite_postResults + + implicit none + integer(pInt) :: & + thePos, & + theSize, & + myNgrains, & + myCrystallite, & + g, & !< grain number + i, & !< integration point number + e !< element number +#ifdef FEM + integer(pInt) :: & + myHomog, & + myPhase, & + crystalliteCtr(material_Ncrystallite, homogenization_maxNgrains), & + phaseCtr (material_Nphase, homogenization_maxNgrains) + real(pReal), dimension(1+crystallite_maxSizePostResults + & + 1+constitutive_plasticity_maxSizePostResults + & + constitutive_source_maxSizePostResults) :: & + crystalliteResults + + + + crystalliteCtr = 0_pInt; phaseCtr = 0_pInt + elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(mesh_element(3,e)) + myCrystallite = microstructure_crystallite(mesh_element(4,e)) + IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + myHomog = mappingHomogenization(2,i,e) + thePos = mappingHomogenization(1,i,e) + homogOutput(myHomog)%output(1: & + homogOutput(myHomog)%sizeResults, & + thePos) = homogenization_postResults(i,e) + + grainLooping :do g = 1,myNgrains + myPhase = phaseAt(g,i,e) + crystalliteResults(1:1+crystallite_sizePostResults(myCrystallite) + & + 1+plasticState(myPhase)%sizePostResults + & + sum(sourceState(myPhase)%p(:)%sizePostResults)) = crystallite_postResults(g,i,e) + if (microstructure_crystallite(mesh_element(4,e)) == myCrystallite .and. & + homogenization_Ngrains (mesh_element(3,e)) >= g) then + crystalliteCtr(myCrystallite,g) = crystalliteCtr(myCrystallite,g) + 1_pInt + crystalliteOutput(myCrystallite,g)% & + output(1:crystalliteOutput(myCrystallite,g)%sizeResults,crystalliteCtr(myCrystallite,g)) = & + crystalliteResults(2:1+crystalliteOutput(myCrystallite,g)%sizeResults) + endif + if (material_phase(g,i,e) == myPhase) then + phaseCtr(myPhase,g) = phaseCtr(myPhase,g) + 1_pInt + phaseOutput(myPhase,g)% & + output(1:phaseOutput(myPhase,g)%sizeResults,phaseCtr(myPhase,g)) = & + crystalliteResults(3 + crystalliteOutput(myCrystallite,g)%sizeResults: & + 1 + crystalliteOutput(myCrystallite,g)%sizeResults + & + 1 + plasticState (myphase)%sizePostResults + & + sum(sourceState(myphase)%p(:)%sizePostResults)) + endif + enddo grainLooping + enddo IpLooping + enddo elementLooping +#else + + !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize) + elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(mesh_element(3,e)) + myCrystallite = microstructure_crystallite(mesh_element(4,e)) + IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + thePos = 0_pInt + + theSize = homogState (mappingHomogenization(2,i,e))%sizePostResults & + + thermalState (mappingHomogenization(2,i,e))%sizePostResults & + + damageState (mappingHomogenization(2,i,e))%sizePostResults & + + vacancyfluxState (mappingHomogenization(2,i,e))%sizePostResults & + + porosityState (mappingHomogenization(2,i,e))%sizePostResults & + + hydrogenfluxState(mappingHomogenization(2,i,e))%sizePostResults + materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results + thePos = thePos + 1_pInt + + if (theSize > 0_pInt) then ! any homogenization results to mention? + materialpoint_results(thePos+1:thePos+theSize,i,e) = homogenization_postResults(i,e) ! tell homogenization results + thePos = thePos + theSize + endif + + materialpoint_results(thePos+1,i,e) = real(myNgrains,pReal) ! tell number of grains at materialpoint + thePos = thePos + 1_pInt + + grainLooping :do g = 1,myNgrains + theSize = 1 + crystallite_sizePostResults(myCrystallite) + & + 1 + plasticState (material_phase(g,i,e))%sizePostResults + & !ToDo + sum(sourceState(material_phase(g,i,e))%p(:)%sizePostResults) + materialpoint_results(thePos+1:thePos+theSize,i,e) = crystallite_postResults(g,i,e) ! tell crystallite results + thePos = thePos + theSize + enddo grainLooping + enddo IpLooping + enddo elementLooping + !$OMP END PARALLEL DO +#endif + +end subroutine materialpoint_postResults + + +!-------------------------------------------------------------------------------------------------- +!> @brief partition material point def grad onto constituents +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_partitionDeformation(ip,el) + use mesh, only: & + mesh_element + use material, only: & + homogenization_type, & + homogenization_maxNgrains, & + HOMOGENIZATION_NONE_ID, & + HOMOGENIZATION_ISOSTRAIN_ID, & + HOMOGENIZATION_RGC_ID + use crystallite, only: & + crystallite_partionedF + use homogenization_isostrain, only: & + homogenization_isostrain_partitionDeformation + use homogenization_RGC, only: & + homogenization_RGC_partitionDeformation + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element number + + chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) + + case (HOMOGENIZATION_NONE_ID) chosenHomogenization + crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el) = 0.0_pReal + crystallite_partionedF(1:3,1:3,1:1,ip,el) = & + spread(materialpoint_subF(1:3,1:3,ip,el),3,1) + + case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization + call homogenization_isostrain_partitionDeformation(& + crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & + materialpoint_subF(1:3,1:3,ip,el),& + el) + case (HOMOGENIZATION_RGC_ID) chosenHomogenization + call homogenization_RGC_partitionDeformation(& + crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & + materialpoint_subF(1:3,1:3,ip,el),& + ip, & + el) + end select chosenHomogenization + +end subroutine homogenization_partitionDeformation + + +!-------------------------------------------------------------------------------------------------- +!> @brief update the internal state of the homogenization scheme and tell whether "done" and +!> "happy" with result +!-------------------------------------------------------------------------------------------------- +function homogenization_updateState(ip,el) + use mesh, only: & + mesh_element + use material, only: & + homogenization_type, & + thermal_type, & + damage_type, & + vacancyflux_type, & + homogenization_maxNgrains, & + HOMOGENIZATION_RGC_ID, & + THERMAL_adiabatic_ID, & + DAMAGE_local_ID, & + VACANCYFLUX_isochempot_ID + use crystallite, only: & + crystallite_P, & + crystallite_dPdF, & + crystallite_partionedF,& + crystallite_partionedF0 + use homogenization_RGC, only: & + homogenization_RGC_updateState + use thermal_adiabatic, only: & + thermal_adiabatic_updateState + use damage_local, only: & + damage_local_updateState + use vacancyflux_isochempot, only: & + vacancyflux_isochempot_updateState + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element number + logical, dimension(2) :: homogenization_updateState + + homogenization_updateState = .true. + chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) + case (HOMOGENIZATION_RGC_ID) chosenHomogenization + homogenization_updateState = & + homogenization_updateState .and. & + homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & + crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & + crystallite_partionedF0(1:3,1:3,1:homogenization_maxNgrains,ip,el),& + materialpoint_subF(1:3,1:3,ip,el),& + materialpoint_subdt(ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & + ip, & + el) + end select chosenHomogenization + + chosenThermal: select case (thermal_type(mesh_element(3,el))) + case (THERMAL_adiabatic_ID) chosenThermal + homogenization_updateState = & + homogenization_updateState .and. & + thermal_adiabatic_updateState(materialpoint_subdt(ip,el), & + ip, & + el) + end select chosenThermal + + chosenDamage: select case (damage_type(mesh_element(3,el))) + case (DAMAGE_local_ID) chosenDamage + homogenization_updateState = & + homogenization_updateState .and. & + damage_local_updateState(materialpoint_subdt(ip,el), & + ip, & + el) + end select chosenDamage + + chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el))) + case (VACANCYFLUX_isochempot_ID) chosenVacancyflux + homogenization_updateState = & + homogenization_updateState .and. & + vacancyflux_isochempot_updateState(materialpoint_subdt(ip,el), & + ip, & + el) + end select chosenVacancyflux + +end function homogenization_updateState + + +!-------------------------------------------------------------------------------------------------- +!> @brief derive average stress and stiffness from constituent quantities +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_averageStressAndItsTangent(ip,el) + use mesh, only: & + mesh_element + use material, only: & + homogenization_type, & + homogenization_maxNgrains, & + HOMOGENIZATION_NONE_ID, & + HOMOGENIZATION_ISOSTRAIN_ID, & + HOMOGENIZATION_RGC_ID + use crystallite, only: & + crystallite_P,crystallite_dPdF + use homogenization_isostrain, only: & + homogenization_isostrain_averageStressAndItsTangent + use homogenization_RGC, only: & + homogenization_RGC_averageStressAndItsTangent + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element number + + chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) + case (HOMOGENIZATION_NONE_ID) chosenHomogenization + materialpoint_P(1:3,1:3,ip,el) = sum(crystallite_P(1:3,1:3,1:1,ip,el),3) + materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) & + = sum(crystallite_dPdF(1:3,1:3,1:3,1:3,1:1,ip,el),5) + + case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization + call homogenization_isostrain_averageStressAndItsTangent(& + materialpoint_P(1:3,1:3,ip,el), & + materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),& + crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & + el) + case (HOMOGENIZATION_RGC_ID) chosenHomogenization + call homogenization_RGC_averageStressAndItsTangent(& + materialpoint_P(1:3,1:3,ip,el), & + materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),& + crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & + el) + end select chosenHomogenization + +end subroutine homogenization_averageStressAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of homogenization results for post file inclusion. call only, +!> if homogenization_sizePostResults(i,e) > 0 !! +!-------------------------------------------------------------------------------------------------- +function homogenization_postResults(ip,el) + use mesh, only: & + mesh_element + use material, only: & + mappingHomogenization, & + homogState, & + thermalState, & + damageState, & + vacancyfluxState, & + porosityState, & + hydrogenfluxState, & + homogenization_type, & + thermal_type, & + damage_type, & + vacancyflux_type, & + porosity_type, & + hydrogenflux_type, & + HOMOGENIZATION_NONE_ID, & + HOMOGENIZATION_ISOSTRAIN_ID, & + HOMOGENIZATION_RGC_ID, & + THERMAL_isothermal_ID, & + THERMAL_adiabatic_ID, & + THERMAL_conduction_ID, & + DAMAGE_none_ID, & + DAMAGE_local_ID, & + DAMAGE_nonlocal_ID, & + VACANCYFLUX_isoconc_ID, & + VACANCYFLUX_isochempot_ID, & + VACANCYFLUX_cahnhilliard_ID, & + POROSITY_none_ID, & + POROSITY_phasefield_ID, & + HYDROGENFLUX_isoconc_ID, & + HYDROGENFLUX_cahnhilliard_ID + use homogenization_isostrain, only: & + homogenization_isostrain_postResults + use homogenization_RGC, only: & + homogenization_RGC_postResults + use thermal_adiabatic, only: & + thermal_adiabatic_postResults + use thermal_conduction, only: & + thermal_conduction_postResults + use damage_local, only: & + damage_local_postResults + use damage_nonlocal, only: & + damage_nonlocal_postResults + use vacancyflux_isochempot, only: & + vacancyflux_isochempot_postResults + use vacancyflux_cahnhilliard, only: & + vacancyflux_cahnhilliard_postResults + use porosity_phasefield, only: & + porosity_phasefield_postResults + use hydrogenflux_cahnhilliard, only: & + hydrogenflux_cahnhilliard_postResults + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element number + real(pReal), dimension( homogState (mappingHomogenization(2,ip,el))%sizePostResults & + + thermalState (mappingHomogenization(2,ip,el))%sizePostResults & + + damageState (mappingHomogenization(2,ip,el))%sizePostResults & + + vacancyfluxState (mappingHomogenization(2,ip,el))%sizePostResults & + + porosityState (mappingHomogenization(2,ip,el))%sizePostResults & + + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults) :: & + homogenization_postResults + integer(pInt) :: & + startPos, endPos + + homogenization_postResults = 0.0_pReal + + startPos = 1_pInt + endPos = homogState(mappingHomogenization(2,ip,el))%sizePostResults + chosenHomogenization: select case (homogenization_type(mesh_element(3,el))) + case (HOMOGENIZATION_NONE_ID) chosenHomogenization + + case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization + homogenization_postResults(startPos:endPos) = & + homogenization_isostrain_postResults(& + ip, & + el, & + materialpoint_P(1:3,1:3,ip,el), & + materialpoint_F(1:3,1:3,ip,el)) + case (HOMOGENIZATION_RGC_ID) chosenHomogenization + homogenization_postResults(startPos:endPos) = & + homogenization_RGC_postResults(& + ip, & + el, & + materialpoint_P(1:3,1:3,ip,el), & + materialpoint_F(1:3,1:3,ip,el)) + end select chosenHomogenization + + startPos = endPos + 1_pInt + endPos = endPos + thermalState(mappingHomogenization(2,ip,el))%sizePostResults + chosenThermal: select case (thermal_type(mesh_element(3,el))) + case (THERMAL_isothermal_ID) chosenThermal + + case (THERMAL_adiabatic_ID) chosenThermal + homogenization_postResults(startPos:endPos) = & + thermal_adiabatic_postResults(ip, el) + case (THERMAL_conduction_ID) chosenThermal + homogenization_postResults(startPos:endPos) = & + thermal_conduction_postResults(ip, el) + end select chosenThermal + + startPos = endPos + 1_pInt + endPos = endPos + damageState(mappingHomogenization(2,ip,el))%sizePostResults + chosenDamage: select case (damage_type(mesh_element(3,el))) + case (DAMAGE_none_ID) chosenDamage + + case (DAMAGE_local_ID) chosenDamage + homogenization_postResults(startPos:endPos) = & + damage_local_postResults(ip, el) + + case (DAMAGE_nonlocal_ID) chosenDamage + homogenization_postResults(startPos:endPos) = & + damage_nonlocal_postResults(ip, el) + end select chosenDamage + + startPos = endPos + 1_pInt + endPos = endPos + vacancyfluxState(mappingHomogenization(2,ip,el))%sizePostResults + chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el))) + case (VACANCYFLUX_isoconc_ID) chosenVacancyflux + + case (VACANCYFLUX_isochempot_ID) chosenVacancyflux + homogenization_postResults(startPos:endPos) = & + vacancyflux_isochempot_postResults(ip, el) + case (VACANCYFLUX_cahnhilliard_ID) chosenVacancyflux + homogenization_postResults(startPos:endPos) = & + vacancyflux_cahnhilliard_postResults(ip, el) + end select chosenVacancyflux + + startPos = endPos + 1_pInt + endPos = endPos + porosityState(mappingHomogenization(2,ip,el))%sizePostResults + chosenPorosity: select case (porosity_type(mesh_element(3,el))) + case (POROSITY_none_ID) chosenPorosity + + case (POROSITY_phasefield_ID) chosenPorosity + homogenization_postResults(startPos:endPos) = & + porosity_phasefield_postResults(ip, el) + end select chosenPorosity + + startPos = endPos + 1_pInt + endPos = endPos + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults + chosenHydrogenflux: select case (hydrogenflux_type(mesh_element(3,el))) + case (HYDROGENFLUX_isoconc_ID) chosenHydrogenflux + + case (HYDROGENFLUX_cahnhilliard_ID) chosenHydrogenflux + homogenization_postResults(startPos:endPos) = & + hydrogenflux_cahnhilliard_postResults(ip, el) + end select chosenHydrogenflux + +end function homogenization_postResults + +end module homogenization diff --git a/code/homogenization/homogenization_RGC.f90 b/code/homogenization/homogenization_RGC.f90 new file mode 100644 index 000000000..323ca2934 --- /dev/null +++ b/code/homogenization/homogenization_RGC.f90 @@ -0,0 +1,1558 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Relaxed grain cluster (RGC) homogenization scheme +!> Ngrains is defined as p x q x r (cluster) +!-------------------------------------------------------------------------------------------------- +module homogenization_RGC + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public :: & + homogenization_RGC_sizeState, & + homogenization_RGC_sizePostResults + integer(pInt), dimension(:,:), allocatable,target, public :: & + homogenization_RGC_sizePostResult + character(len=64), dimension(:,:), allocatable,target, public :: & + homogenization_RGC_output ! name of each post result output + integer(pInt), dimension(:), allocatable,target, public :: & + homogenization_RGC_Noutput !< number of outputs per homog instance + integer(pInt), dimension(:,:), allocatable, private :: & + homogenization_RGC_Ngrains + real(pReal), dimension(:,:), allocatable, private :: & + homogenization_RGC_dAlpha, & + homogenization_RGC_angles + real(pReal), dimension(:,:,:,:), allocatable, private :: & + homogenization_RGC_orientation + real(pReal), dimension(:), allocatable, private :: & + homogenization_RGC_xiAlpha, & + homogenization_RGC_ciAlpha + enum, bind(c) + enumerator :: undefined_ID, & + constitutivework_ID, & + penaltyenergy_ID, & + volumediscrepancy_ID, & + averagerelaxrate_ID,& + maximumrelaxrate_ID,& + ipcoords_ID,& + magnitudemismatch_ID,& + avgdefgrad_ID,& + avgfirstpiola_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + homogenization_RGC_outputID !< ID of each post result output + + public :: & + homogenization_RGC_init, & + homogenization_RGC_partitionDeformation, & + homogenization_RGC_averageStressAndItsTangent, & + homogenization_RGC_updateState, & + homogenization_RGC_postResults + private :: & + homogenization_RGC_stressPenalty, & + homogenization_RGC_volumePenalty, & + homogenization_RGC_grainDeformation, & + homogenization_RGC_surfaceCorrection, & + homogenization_RGC_equivalentModuli, & + homogenization_RGC_relaxationVector, & + homogenization_RGC_interfaceNormal, & + homogenization_RGC_getInterface, & + homogenization_RGC_grain1to3, & + homogenization_RGC_grain3to1, & + homogenization_RGC_interface4to1, & + homogenization_RGC_interface1to4 + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, reads information from material configuration file +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_RGC_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + pReal, & + pInt + use debug, only: & + debug_level, & + debug_homogenization, & + debug_levelBasic, & + debug_levelExtensive + use math, only: & + math_Mandel3333to66,& + math_Voigt66to3333, & + math_I3, & + math_sampleRandomOri,& + math_EulerToR,& + INRAD + use mesh, only: & + mesh_maxNips, & + mesh_NcpElems,& + mesh_element, & + FE_Nips, & + FE_geomtype + use IO + use material + use numerics, only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration + integer(pInt), allocatable, dimension(:) :: chunkPos + integer :: & + homog, & + NofMyHomog, & + o, & + instance, & + sizeHState + integer(pInt) :: section=0_pInt, maxNinstance, i,j,e, mySize, myInstance + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) + if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + allocate(homogenization_RGC_sizeState(maxNinstance), source=0_pInt) + allocate(homogenization_RGC_sizePostResults(maxNinstance), source=0_pInt) + allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) + allocate(homogenization_RGC_Ngrains(3,maxNinstance), source=0_pInt) + allocate(homogenization_RGC_ciAlpha(maxNinstance), source=0.0_pReal) + allocate(homogenization_RGC_xiAlpha(maxNinstance), source=0.0_pReal) + allocate(homogenization_RGC_dAlpha(3,maxNinstance), source=0.0_pReal) + allocate(homogenization_RGC_angles(3,maxNinstance), source=400.0_pReal) + allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)) + homogenization_RGC_output='' + allocate(homogenization_RGC_outputID(maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) + allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),maxNinstance),& + source=0_pInt) + allocate(homogenization_RGC_orientation(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + homogenization_RGC_orientation = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity + + rewind(fileUnit) + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>'))/=material_partHomogenization) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homogenization part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next section + section = section + 1_pInt + cycle + endif + if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran + if (homogenization_type(section) == HOMOGENIZATION_RGC_ID) then ! one of my sections + i = homogenization_typeInstance(section) ! which instance of my type is present homogenization + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case('constitutivework') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = constitutivework_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('penaltyenergy') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = penaltyenergy_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('volumediscrepancy') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = volumediscrepancy_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('averagerelaxrate') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = averagerelaxrate_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('maximumrelaxrate') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = maximumrelaxrate_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('magnitudemismatch') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = magnitudemismatch_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('ipcoords') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = ipcoords_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('avgdefgrad','avgf') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgdefgrad_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('avgp','avgfirstpiola','avg1stpiola') + homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt + homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgfirstpiola_ID + homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + + end select + case ('clustersize') + homogenization_RGC_Ngrains(1,i) = IO_intValue(line,chunkPos,2_pInt) + homogenization_RGC_Ngrains(2,i) = IO_intValue(line,chunkPos,3_pInt) + homogenization_RGC_Ngrains(3,i) = IO_intValue(line,chunkPos,4_pInt) + if (homogenization_Ngrains(section) /= product(homogenization_RGC_Ngrains(1:3,i))) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_RGC_label//')') + case ('scalingparameter') + homogenization_RGC_xiAlpha(i) = IO_floatValue(line,chunkPos,2_pInt) + case ('overproportionality') + homogenization_RGC_ciAlpha(i) = IO_floatValue(line,chunkPos,2_pInt) + case ('grainsize') + homogenization_RGC_dAlpha(1,i) = IO_floatValue(line,chunkPos,2_pInt) + homogenization_RGC_dAlpha(2,i) = IO_floatValue(line,chunkPos,3_pInt) + homogenization_RGC_dAlpha(3,i) = IO_floatValue(line,chunkPos,4_pInt) + case ('clusterorientation') + homogenization_RGC_angles(1,i) = IO_floatValue(line,chunkPos,2_pInt) + homogenization_RGC_angles(2,i) = IO_floatValue(line,chunkPos,3_pInt) + homogenization_RGC_angles(3,i) = IO_floatValue(line,chunkPos,4_pInt) + + end select + endif + endif + enddo parsingFile + +!-------------------------------------------------------------------------------------------------- +! * assigning cluster orientations + elementLooping: do e = 1_pInt,mesh_NcpElems + if (homogenization_type(mesh_element(3,e)) == HOMOGENIZATION_RGC_ID) then + myInstance = homogenization_typeInstance(mesh_element(3,e)) + if (all (homogenization_RGC_angles(1:3,myInstance) >= 399.9_pReal)) then + homogenization_RGC_orientation(1:3,1:3,1,e) = math_EulerToR(math_sampleRandomOri()) + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + if (microstructure_elemhomo(mesh_element(4,e))) then + homogenization_RGC_orientation(1:3,1:3,i,e) = homogenization_RGC_orientation(1:3,1:3,1,e) + else + homogenization_RGC_orientation(1:3,1:3,i,e) = math_EulerToR(math_sampleRandomOri()) + endif + enddo + else + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + homogenization_RGC_orientation(1:3,1:3,i,e) = & + math_EulerToR(homogenization_RGC_angles(1:3,myInstance)*inRad) + enddo + endif + endif + enddo elementLooping + + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then + do i = 1_pInt,maxNinstance + write(6,'(a15,1x,i4,/)') 'instance: ', i + write(6,'(a25,3(1x,i8))') 'cluster size: ',(homogenization_RGC_Ngrains(j,i),j=1_pInt,3_pInt) + write(6,'(a25,1x,e10.3)') 'scaling parameter: ', homogenization_RGC_xiAlpha(i) + write(6,'(a25,1x,e10.3)') 'over-proportionality: ', homogenization_RGC_ciAlpha(i) + write(6,'(a25,3(1x,e10.3))') 'grain size: ',(homogenization_RGC_dAlpha(j,i),j=1_pInt,3_pInt) + write(6,'(a25,3(1x,e10.3))') 'cluster orientation: ',(homogenization_RGC_angles(j,i),j=1_pInt,3_pInt) + enddo + endif +!-------------------------------------------------------------------------------------------------- + initializeInstances: do homog = 1_pInt, material_Nhomogenization + myHomog: if (homogenization_type(homog) == HOMOGENIZATION_RGC_ID) then + NofMyHomog = count(material_homog == homog) + instance = homogenization_typeInstance(homog) + +! * Determine size of postResults array + outputsLoop: do o = 1_pInt, homogenization_RGC_Noutput(instance) + select case(homogenization_RGC_outputID(o,instance)) + case(constitutivework_ID,penaltyenergy_ID,volumediscrepancy_ID, & + averagerelaxrate_ID,maximumrelaxrate_ID) + mySize = 1_pInt + case(ipcoords_ID,magnitudemismatch_ID) + mySize = 3_pInt + case(avgdefgrad_ID,avgfirstpiola_ID) + mySize = 9_pInt + case default + mySize = 0_pInt + end select + + outputFound: if (mySize > 0_pInt) then + homogenization_RGC_sizePostResult(o,instance) = mySize + homogenization_RGC_sizePostResults(instance) = & + homogenization_RGC_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop + + sizeHState = & + 3_pInt*(homogenization_RGC_Ngrains(1,instance)-1_pInt)* & + homogenization_RGC_Ngrains(2,instance)*homogenization_RGC_Ngrains(3,instance) & + + 3_pInt*homogenization_RGC_Ngrains(1,instance)*(homogenization_RGC_Ngrains(2,instance)-1_pInt)* & + homogenization_RGC_Ngrains(3,instance) & + + 3_pInt*homogenization_RGC_Ngrains(1,instance)*homogenization_RGC_Ngrains(2,instance)* & + (homogenization_RGC_Ngrains(3,instance)-1_pInt) & + + 8_pInt ! (1) Average constitutive work, (2-4) Overall mismatch, (5) Average penalty energy, + ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component + +! allocate state arrays + homogState(homog)%sizeState = sizeHState + homogState(homog)%sizePostResults = homogenization_RGC_sizePostResults(instance) + allocate(homogState(homog)%state0 (sizeHState,NofMyHomog), source=0.0_pReal) + allocate(homogState(homog)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) + allocate(homogState(homog)%state (sizeHState,NofMyHomog), source=0.0_pReal) + + endif myHomog + enddo initializeInstances + + + +end subroutine homogenization_RGC_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief partitions the deformation gradient onto the constituents +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) + use debug, only: & + debug_level, & + debug_homogenization, & + debug_levelExtensive + use mesh, only: & + mesh_element + use material, only: & + homogenization_maxNgrains, & + homogenization_Ngrains,& + homogenization_typeInstance + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain + real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension (3) :: aVect,nVect + integer(pInt), dimension (4) :: intFace + integer(pInt), dimension (3) :: iGrain3 + integer(pInt) :: homID, iGrain,iFace,i,j + integer(pInt), parameter :: nFace = 6_pInt + +!-------------------------------------------------------------------------------------------------- +! compute the deformation gradient of individual grains due to relaxations + homID = homogenization_typeInstance(mesh_element(3,el)) + F = 0.0_pReal + do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) + iGrain3 = homogenization_RGC_grain1to3(iGrain,homID) + do iFace = 1_pInt,nFace + intFace = homogenization_RGC_getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain + + aVect = homogenization_RGC_relaxationVector(intFace,homID, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array + + nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) ! get the normal of each interface + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & + F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation + enddo + F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient + +!-------------------------------------------------------------------------------------------------- +! debugging the grain deformation gradients + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain + do i = 1_pInt,3_pInt + write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1_pInt,3_pInt) + enddo + write(6,*)' ' + flush(6) + !$OMP END CRITICAL (write2out) + endif + + enddo + +end subroutine homogenization_RGC_partitionDeformation + + +!-------------------------------------------------------------------------------------------------- +!> @brief update the internal state of the homogenization scheme and tell whether "done" and +! "happy" with result +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) + use debug, only: & + debug_level, & + debug_homogenization,& + debug_levelExtensive, & + debug_e, & + debug_i + use math, only: & + math_invert + use mesh, only: & + mesh_element + use material, only: & + homogenization_maxNgrains, & + homogenization_typeInstance, & + homogState, & + mappingHomogenization, & + homogenization_Ngrains + use numerics, only: & + absTol_RGC, & + relTol_RGC, & + absMax_RGC, & + relMax_RGC, & + pPert_RGC, & + maxdRelax_RGC, & + viscPower_RGC, & + viscModus_RGC, & + refRelaxRate_RGC + + implicit none + + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: & + P,& !< array of P + F,& !< array of F + F0 !< array of initial F + real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffness + real(pReal), dimension (3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + logical, dimension(2) :: homogenization_RGC_updateState + integer(pInt), dimension (4) :: intFaceN,intFaceP,faceID + integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P,stresLoc + integer(pInt), dimension (2) :: residLoc + integer(pInt) homID,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain + real(pReal), dimension (3,3,homogenization_maxNgrains) :: R,pF,pR,D,pD + real(pReal), dimension (3,homogenization_maxNgrains) :: NN,pNN + real(pReal), dimension (3) :: normP,normN,mornP,mornN + real(pReal) :: residMax,stresMax,constitutiveWork,penaltyEnergy,volDiscrep + logical error + + integer(pInt), parameter :: nFace = 6_pInt + + real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix + real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax + + if(abs(dt) < tiny(0.0_pReal)) then ! zero time step + homogenization_RGC_updateState = .true. ! pretend everything is fine and return + return + endif + +!-------------------------------------------------------------------------------------------------- +! get the dimension of the cluster (grains and interfaces) + homID = homogenization_typeInstance(mesh_element(3,el)) + nGDim = homogenization_RGC_Ngrains(1:3,homID) + nGrain = homogenization_Ngrains(mesh_element(3,el)) + nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & + + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) + +!-------------------------------------------------------------------------------------------------- +! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster + allocate(resid(3_pInt*nIntFaceTot), source=0.0_pReal) + allocate(tract(nIntFaceTot,3), source=0.0_pReal) + allocate(relax(3_pInt*nIntFaceTot)); relax= homogState(mappingHomogenization(2,ip,el))% & + state(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) + allocate(drelax(3_pInt*nIntFaceTot)); drelax= homogState(mappingHomogenization(2,ip,el))% & + state(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) - & + homogState(mappingHomogenization(2,ip,el))% & + state0(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) +!-------------------------------------------------------------------------------------------------- +! debugging the obtained state + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30)')'Obtained state: ' + do i = 1_pInt,3_pInt*nIntFaceTot + write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,mappingHomogenization(1,ip,el)) + enddo + write(6,*)' ' + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! computing interface mismatch and stress penalty tensor for all interfaces of all grains + call homogenization_RGC_stressPenalty(R,NN,avgF,F,ip,el,homID) + +!-------------------------------------------------------------------------------------------------- +! calculating volume discrepancy and stress penalty related to overall volume discrepancy + call homogenization_RGC_volumePenalty(D,volDiscrep,F,avgF,ip,el) + +!-------------------------------------------------------------------------------------------------- +! debugging the mismatch, stress and penalties of grains + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + do iGrain = 1_pInt,nGrain + write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',& + NN(1,iGrain),NN(2,iGrain),NN(3,iGrain) + write(6,'(/,1x,a30,1x,i3)')'Stress and penalties of grain: ',iGrain + do i = 1_pInt,3_pInt + write(6,'(1x,3(e15.8,1x),1x,3(e15.8,1x),1x,3(e15.8,1x))')(P(i,j,iGrain), j = 1_pInt,3_pInt), & + (R(i,j,iGrain), j = 1_pInt,3_pInt), & + (D(i,j,iGrain), j = 1_pInt,3_pInt) + enddo + write(6,*)' ' + enddo + !$OMP END CRITICAL (write2out) + endif + +!------------------------------------------------------------------------------------------------ +! computing the residual stress from the balance of traction at all (interior) interfaces + do iNum = 1_pInt,nIntFaceTot + faceID = homogenization_RGC_interface1to4(iNum,homID) ! identifying the interface ID in local coordinate system (4-dimensional index) + +!-------------------------------------------------------------------------------------------------- +! identify the left/bottom/back grain (-|N) + iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) + iGrN = homogenization_RGC_grain3to1(iGr3N,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) + normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the interface normal + +!-------------------------------------------------------------------------------------------------- +! identify the right/up/front grain (+|P) + iGr3P = iGr3N + iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) + iGrP = homogenization_RGC_grain3to1(iGr3P,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) + normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the interface normal + +!-------------------------------------------------------------------------------------------------- +! compute the residual of traction at the interface (in local system, 4-dimensional index) + do i = 1_pInt,3_pInt + tract(iNum,i) = sign(viscModus_RGC*(abs(drelax(i+3*(iNum-1_pInt)))/(refRelaxRate_RGC*dt))**viscPower_RGC, & + drelax(i+3*(iNum-1_pInt))) ! contribution from the relaxation viscosity + do j = 1_pInt,3_pInt + tract(iNum,i) = tract(iNum,i) + (P(i,j,iGrP) + R(i,j,iGrP) + D(i,j,iGrP))*normP(j) & ! contribution from material stress P, mismatch penalty R, and volume penalty D projected into the interface + + (P(i,j,iGrN) + R(i,j,iGrN) + D(i,j,iGrN))*normN(j) + resid(i+3_pInt*(iNum-1_pInt)) = tract(iNum,i) ! translate the local residual into global 1-dimensional residual array + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! debugging the residual stress + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum + write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1_pInt,3_pInt) + write(6,*)' ' + !$OMP END CRITICAL (write2out) + endif + enddo + +!-------------------------------------------------------------------------------------------------- +! convergence check for stress residual + stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress + stresLoc = int(maxloc(abs(P)),pInt) ! get the location of the maximum stress + residMax = maxval(abs(tract)) ! get the maximum of the residual + residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual + +!-------------------------------------------------------------------------------------------------- +! Debugging the convergent criteria + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a)')' ' + write(6,'(1x,a,1x,i2,1x,i4)')'RGC residual check ...',ip,el + write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2,i2)')'Max stress: ',stresMax, & + '@ grain',stresLoc(3),'in component',stresLoc(1),stresLoc(2) + write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2)')'Max residual: ',residMax, & + '@ iface',residLoc(1),'in direction',residLoc(2) + flush(6) + !$OMP END CRITICAL (write2out) + endif + + homogenization_RGC_updateState = .false. + +!-------------------------------------------------------------------------------------------------- +! If convergence reached => done and happy + if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then + homogenization_RGC_updateState = .true. + + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a55,/)')'... done and happy' + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! compute/update the state for postResult, i.e., all energy densities computed by time-integration + constitutiveWork = homogState(mappingHomogenization(2,ip,el))%state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) + penaltyEnergy = homogState(mappingHomogenization(2,ip,el))%state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) + do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) ! time-integration loop for the calculating the work and energy + do i = 1_pInt,3_pInt + do j = 1_pInt,3_pInt + constitutiveWork = constitutiveWork + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) + penaltyEnergy = penaltyEnergy + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) + enddo + enddo + enddo + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) = constitutiveWork ! the bulk mechanical/constitutive work + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+2,mappingHomogenization(1,ip,el)) = sum(NN(1,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e1-direction + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+3,mappingHomogenization(1,ip,el)) = sum(NN(2,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e2-direction + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+4,mappingHomogenization(1,ip,el)) = sum(NN(3,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e3-direction + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) = penaltyEnergy ! the overall penalty energy + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+6,mappingHomogenization(1,ip,el)) = volDiscrep ! the overall volume discrepancy + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+7,mappingHomogenization(1,ip,el)) = & + sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) ! the average rate of relaxation vectors + homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+8,mappingHomogenization(1,ip,el)) = maxval(abs(drelax))/dt ! the maximum rate of relaxation vectors + + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',constitutiveWork + write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',sum(NN(1,:))/real(nGrain,pReal), & + sum(NN(2,:))/real(nGrain,pReal), & + sum(NN(3,:))/real(nGrain,pReal) + write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ',penaltyEnergy + write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ',volDiscrep + write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ',maxval(abs(drelax))/dt + write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ',sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) + flush(6) + !$OMP END CRITICAL (write2out) + endif + + deallocate(tract,resid,relax,drelax) + return + +!-------------------------------------------------------------------------------------------------- +! if residual blows-up => done but unhappy + elseif (residMax > relMax_RGC*stresMax .or. residMax > absMax_RGC) then ! try to restart when residual blows up exceeding maximum bound + homogenization_RGC_updateState = [.true.,.false.] ! with direct cut-back + + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a55,/)')'... broken' + flush(6) + !$OMP END CRITICAL (write2out) + endif + + deallocate(tract,resid,relax,drelax) + return + else ! proceed with computing the Jacobian and state update + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a55,/)')'... not yet done' + flush(6) + !$OMP END CRITICAL (write2out) + endif + + endif + +!--------------------------------------------------------------------------------------------------- +! construct the global Jacobian matrix for updating the global relaxation vector array when +! convergence is not yet reached ... + +!-------------------------------------------------------------------------------------------------- +! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix" + allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) + do iNum = 1_pInt,nIntFaceTot + faceID = homogenization_RGC_interface1to4(iNum,homID) ! assembling of local dPdF into global Jacobian matrix + +!-------------------------------------------------------------------------------------------------- +! identify the left/bottom/back grain (-|N) + iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate sytem + iGrN = homogenization_RGC_grain3to1(iGr3N,homID) ! translate into global grain ID + intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system + normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the interface normal + do iFace = 1_pInt,nFace + intFaceN = homogenization_RGC_getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface + mornN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get normal of the interfaces + iMun = homogenization_RGC_interface4to1(intFaceN,homID) ! translate the interfaces ID into local 4-dimensional index + if (iMun > 0) then ! get the corresponding tangent + do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt + smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrN)*normN(k)*mornN(l) + enddo;enddo;enddo;enddo +! projecting the material tangent dPdF into the interface +! to obtain the Jacobian matrix contribution of dPdF + endif + enddo + +!-------------------------------------------------------------------------------------------------- +! identify the right/up/front grain (+|P) + iGr3P = iGr3N + iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate sytem + iGrP = homogenization_RGC_grain3to1(iGr3P,homID) ! translate into global grain ID + intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system + normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the interface normal + do iFace = 1_pInt,nFace + intFaceP = homogenization_RGC_getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface + mornP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get normal of the interfaces + iMun = homogenization_RGC_interface4to1(intFaceP,homID) ! translate the interfaces ID into local 4-dimensional index + if (iMun > 0_pInt) then ! get the corresponding tangent + do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt + smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrP)*normP(k)*mornP(l) + enddo;enddo;enddo;enddo + endif + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! debugging the global Jacobian matrix of stress tangent + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30)')'Jacobian matrix of stress' + do i = 1_pInt,3_pInt*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical +! perturbation method) "pmatrix" + allocate(pmatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) + allocate(p_relax(3*nIntFaceTot), source=0.0_pReal) + allocate(p_resid(3*nIntFaceTot), source=0.0_pReal) + do ipert = 1_pInt,3_pInt*nIntFaceTot + p_relax = relax + p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector + homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,mappingHomogenization(1,ip,el)) = p_relax + call homogenization_RGC_grainDeformation(pF,avgF,ip,el) ! compute the grains deformation from perturbed state + call homogenization_RGC_stressPenalty(pR,pNN,avgF,pF,ip,el,homID) ! compute stress penalty due to interface mismatch from perturbed state + call homogenization_RGC_volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! compute stress penalty due to volume discrepancy from perturbed state + +!-------------------------------------------------------------------------------------------------- +! computing the global stress residual array from the perturbed state + p_resid = 0.0_pReal + do iNum = 1_pInt,nIntFaceTot + faceID = homogenization_RGC_interface1to4(iNum,homID) ! identifying the interface ID in local coordinate system (4-dimensional index) + +!-------------------------------------------------------------------------------------------------- +! identify the left/bottom/back grain (-|N) + iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) + iGrN = homogenization_RGC_grain3to1(iGr3N,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) ! identifying the interface ID of the grain + normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the corresponding interface normal + +!-------------------------------------------------------------------------------------------------- +! identify the right/up/front grain (+|P) + iGr3P = iGr3N + iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) + iGrP = homogenization_RGC_grain3to1(iGr3P,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the interface ID of the grain + normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the corresponding normal + +!-------------------------------------------------------------------------------------------------- +! compute the residual stress (contribution of mismatch and volume penalties) from perturbed state +! at all interfaces + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt + p_resid(i+3*(iNum-1)) = p_resid(i+3*(iNum-1)) + (pR(i,j,iGrP) - R(i,j,iGrP))*normP(j) & + + (pR(i,j,iGrN) - R(i,j,iGrN))*normN(j) & + + (pD(i,j,iGrP) - D(i,j,iGrP))*normP(j) & + + (pD(i,j,iGrN) - D(i,j,iGrN))*normN(j) + enddo; enddo + enddo + pmatrix(:,ipert) = p_resid/pPert_RGC + enddo + +!-------------------------------------------------------------------------------------------------- +! debugging the global Jacobian matrix of penalty tangent + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30)')'Jacobian matrix of penalty' + do i = 1_pInt,3_pInt*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! ... of the numerical viscosity traction "rmatrix" + allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal) + forall (i=1_pInt:3_pInt*nIntFaceTot) & + rmatrix(i,i) = viscModus_RGC*viscPower_RGC/(refRelaxRate_RGC*dt)* & ! tangent due to numerical viscosity traction appears + (abs(drelax(i))/(refRelaxRate_RGC*dt))**(viscPower_RGC - 1.0_pReal) ! only in the main diagonal term + + + +!-------------------------------------------------------------------------------------------------- +! debugging the global Jacobian matrix of numerical viscosity tangent + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30)')'Jacobian matrix of penalty' + do i = 1_pInt,3_pInt*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix + allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix + + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30)')'Jacobian matrix (total)' + do i = 1_pInt,3_pInt*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! computing the update of the state variable (relaxation vectors) using the Jacobian matrix + allocate(jnverse(3_pInt*nIntFaceTot,3_pInt*nIntFaceTot),source=0.0_pReal) + call math_invert(size(jmatrix,1),jmatrix,jnverse,error) ! Compute the inverse of the overall Jacobian matrix + +!-------------------------------------------------------------------------------------------------- +! debugging the inverse Jacobian matrix + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30)')'Jacobian inverse' + do i = 1_pInt,3_pInt*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1_pInt,3_pInt*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration + drelax = 0.0_pReal + do i = 1_pInt,3_pInt*nIntFaceTot + do j = 1_pInt,3_pInt*nIntFaceTot + drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable + enddo + enddo + relax = relax + drelax ! Updateing the state variable for the next iteration + homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,mappingHomogenization(1,ip,el)) = relax + if (any(abs(drelax) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large + homogenization_RGC_updateState = [.true.,.false.] + !$OMP CRITICAL (write2out) + write(6,'(1x,a,1x,i3,1x,a,1x,i3,1x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback' + write(6,'(1x,a,1x,e15.8)')'due to large relaxation change =',maxval(abs(drelax)) + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! debugging the return state + if (iand(debug_homogenization, debug_levelExtensive) > 0_pInt) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30)')'Returned state: ' + do i = 1_pInt,3_pInt*nIntFaceTot + write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,mappingHomogenization(1,ip,el)) + enddo + write(6,*)' ' + flush(6) + !$OMP END CRITICAL (write2out) + endif + + deallocate(tract,resid,jmatrix,jnverse,relax,drelax,pmatrix,smatrix,p_relax,p_resid) + +end function homogenization_RGC_updateState + + +!-------------------------------------------------------------------------------------------------- +!> @brief derive average stress and stiffness from constituent quantities +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,el) + use debug, only: & + debug_level, & + debug_homogenization,& + debug_levelExtensive + use mesh, only: mesh_element + use material, only: & + homogenization_maxNgrains, & + homogenization_Ngrains, & + homogenization_typeInstance + use math, only: math_Plain3333to99 + + implicit none + real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point + real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses + real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses + integer(pInt), intent(in) :: el !< element number + real(pReal), dimension (9,9) :: dPdF99 + + integer(pInt) :: homID, i, j, Ngrains, iGrain + + homID = homogenization_typeInstance(mesh_element(3,el)) + Ngrains = homogenization_Ngrains(mesh_element(3,el)) + +!-------------------------------------------------------------------------------------------------- +! debugging the grain tangent + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then + !$OMP CRITICAL (write2out) + do iGrain = 1_pInt,Ngrains + dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain)) + write(6,'(1x,a30,1x,i3)')'Stress tangent of grain: ',iGrain + do i = 1_pInt,9_pInt + write(6,'(1x,(e15.8,1x))') (dPdF99(i,j), j = 1_pInt,9_pInt) + enddo + write(6,*)' ' + enddo + flush(6) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! computing the average first Piola-Kirchhoff stress P and the average tangent dPdF + avgP = sum(P,3)/real(Ngrains,pReal) + dAvgPdAvgF = sum(dPdF,5)/real(Ngrains,pReal) + +end subroutine homogenization_RGC_averageStressAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of homogenization results for post file inclusion +!-------------------------------------------------------------------------------------------------- +pure function homogenization_RGC_postResults(ip,el,avgP,avgF) + use mesh, only: & + mesh_element, & + mesh_ipCoordinates + use material, only: & + homogenization_typeInstance,& + homogState, & + mappingHomogenization, & + homogenization_Noutput + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3), intent(in) :: & + avgP, & !< average stress at material point + avgF !< average deformation gradient at material point + + integer(pInt) homID,o,c,nIntFaceTot + real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(mesh_element(3,el)))) :: & + homogenization_RGC_postResults + + homID = homogenization_typeInstance(mesh_element(3,el)) + nIntFaceTot=(homogenization_RGC_Ngrains(1,homID)-1_pInt)*homogenization_RGC_Ngrains(2,homID)*homogenization_RGC_Ngrains(3,homID)& + + homogenization_RGC_Ngrains(1,homID)*(homogenization_RGC_Ngrains(2,homID)-1_pInt)*homogenization_RGC_Ngrains(3,homID)& + + homogenization_RGC_Ngrains(1,homID)*homogenization_RGC_Ngrains(2,homID)*(homogenization_RGC_Ngrains(3,homID)-1_pInt) + + c = 0_pInt + homogenization_RGC_postResults = 0.0_pReal + do o = 1_pInt,homogenization_Noutput(mesh_element(3,el)) + select case(homogenization_RGC_outputID(o,homID)) + case (avgdefgrad_ID) + homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(avgF,[9]) + c = c + 9_pInt + case (avgfirstpiola_ID) + homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(avgP,[9]) + c = c + 9_pInt + case (ipcoords_ID) + homogenization_RGC_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el) ! current ip coordinates + c = c + 3_pInt + case (constitutivework_ID) + homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) + c = c + 1_pInt + case (magnitudemismatch_ID) + homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+2,mappingHomogenization(1,ip,el)) + homogenization_RGC_postResults(c+2) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+3,mappingHomogenization(1,ip,el)) + homogenization_RGC_postResults(c+3) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+4,mappingHomogenization(1,ip,el)) + c = c + 3_pInt + case (penaltyenergy_ID) + homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) + c = c + 1_pInt + case (volumediscrepancy_ID) + homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+6,mappingHomogenization(1,ip,el)) + c = c + 1_pInt + case (averagerelaxrate_ID) + homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+7,mappingHomogenization(1,ip,el)) + c = c + 1_pInt + case (maximumrelaxrate_ID) + homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + state(3*nIntFaceTot+8,mappingHomogenization(1,ip,el)) + c = c + 1_pInt + end select + enddo + +end function homogenization_RGC_postResults + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculate stress-like penalty due to deformation mismatch +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,homID) + use debug, only: & + debug_level, & + debug_homogenization,& + debug_levelExtensive, & + debug_e, & + debug_i + use mesh, only: & + mesh_element + use constitutive, only: & + constitutive_homogenizedC + use math, only: & + math_civita + use material, only: & + homogenization_maxNgrains,& + homogenization_Ngrains + use numerics, only: & + xSmoo_RGC + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: rPen !< stress-like penalty + real(pReal), dimension (3,homogenization_maxNgrains), intent(out) :: nMis !< total amount of mismatch + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef !< deformation gradients + real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor + integer(pInt), intent(in) :: ip,el + integer(pInt), dimension (4) :: intFace + integer(pInt), dimension (3) :: iGrain3,iGNghb3,nGDim + real(pReal), dimension (3,3) :: gDef,nDef + real(pReal), dimension (3) :: nVect,surfCorr + real(pReal), dimension (2) :: Gmoduli + integer(pInt) :: homID,iGrain,iGNghb,iFace,i,j,k,l + real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb + + integer(pInt), parameter :: nFace = 6_pInt + real(pReal), parameter :: nDefToler = 1.0e-10_pReal + + nGDim = homogenization_RGC_Ngrains(1:3,homID) + rPen = 0.0_pReal + nMis = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! get the correction factor the modulus of penalty stress representing the evolution of area of +! the interfaces due to deformations + surfCorr = homogenization_RGC_surfaceCorrection(avgF,ip,el) + +!-------------------------------------------------------------------------------------------------- +! debugging the surface correction factor + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el + write(6,'(1x,3(e11.4,1x))')(surfCorr(i), i = 1,3) + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! computing the mismatch and penalty stress tensor of all grains + do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) + Gmoduli = homogenization_RGC_equivalentModuli(iGrain,ip,el) + muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain + bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector + iGrain3 = homogenization_RGC_grain1to3(iGrain,homID) ! get the grain ID in local 3-dimensional index (x,y,z)-position + +!* Looping over all six interfaces of each grain + do iFace = 1_pInt,nFace + intFace = homogenization_RGC_getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain + nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) ! get the interface normal + iGNghb3 = iGrain3 ! identify the neighboring grain across the interface + iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) + if (iGNghb3(1) < 1) iGNghb3(1) = nGDim(1) ! with periodicity along e1 direction + if (iGNghb3(1) > nGDim(1)) iGNghb3(1) = 1_pInt + if (iGNghb3(2) < 1) iGNghb3(2) = nGDim(2) ! with periodicity along e2 direction + if (iGNghb3(2) > nGDim(2)) iGNghb3(2) = 1_pInt + if (iGNghb3(3) < 1) iGNghb3(3) = nGDim(3) ! with periodicity along e3 direction + if (iGNghb3(3) > nGDim(3)) iGNghb3(3) = 1_pInt + iGNghb = homogenization_RGC_grain3to1(iGNghb3,homID) ! get the ID of the neighboring grain + Gmoduli = homogenization_RGC_equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor + muGNghb = Gmoduli(1) + bgGNghb = Gmoduli(2) + gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! compute the difference/jump in deformation gradeint across the neighbor + +!-------------------------------------------------------------------------------------------------- +! compute the mismatch tensor of all interfaces + nDefNorm = 0.0_pReal + nDef = 0.0_pReal + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt + do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt + nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_civita(j,k,l) ! compute the interface mismatch tensor from the jump of deformation gradient + enddo; enddo + nDefNorm = nDefNorm + nDef(i,j)*nDef(i,j) ! compute the norm of the mismatch tensor + enddo; enddo + nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) + nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) + +!-------------------------------------------------------------------------------------------------- +! debuggin the mismatch tensor + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb + do i = 1,3 + write(6,'(1x,3(e11.4,1x))')(nDef(i,j), j = 1,3) + enddo + write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm + !$OMP END CRITICAL (write2out) + endif + +!-------------------------------------------------------------------------------------------------- +! compute the stress penalty of all interfaces + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt + do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*homogenization_RGC_xiAlpha(homID) & + *surfCorr(abs(intFace(1)))/homogenization_RGC_dAlpha(abs(intFace(1)),homID) & + *cosh(homogenization_RGC_ciAlpha(homID)*nDefNorm) & + *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & + *tanh(nDefNorm/xSmoo_RGC) + enddo; enddo + enddo; enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! debugging the stress-like penalty + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain + do i = 1,3 + write(6,'(1x,3(e11.4,1x))')(rPen(i,j,iGrain), j = 1,3) + enddo + !$OMP END CRITICAL (write2out) + endif + + enddo + +end subroutine homogenization_RGC_stressPenalty + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculate stress-like penalty due to volume discrepancy +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_RGC_volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) + use debug, only: & + debug_level, & + debug_homogenization,& + debug_levelExtensive, & + debug_e, & + debug_i + use mesh, only: & + mesh_element + use math, only: & + math_det33, & + math_inv33 + use material, only: & + homogenization_maxNgrains,& + homogenization_Ngrains + use numerics, only: & + maxVolDiscr_RGC,& + volDiscrMod_RGC,& + volDiscrPow_RGC + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: vPen ! stress-like penalty due to volume + real(pReal), intent(out) :: vDiscrep ! total volume discrepancy + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef ! deformation gradients + real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient + integer(pInt), intent(in) :: ip,& ! integration point + el + real(pReal), dimension (homogenization_maxNgrains) :: gVol + integer(pInt) :: iGrain,nGrain,i,j + + nGrain = homogenization_Ngrains(mesh_element(3,el)) + +!-------------------------------------------------------------------------------------------------- +! compute the volumes of grains and of cluster + vDiscrep = math_det33(fAvg) ! compute the volume of the cluster + do iGrain = 1_pInt,nGrain + gVol(iGrain) = math_det33(fDef(1:3,1:3,iGrain)) ! compute the volume of individual grains + vDiscrep = vDiscrep - gVol(iGrain)/real(nGrain,pReal) ! calculate the difference/dicrepancy between + ! the volume of the cluster and the the total volume of grains + enddo + +!-------------------------------------------------------------------------------------------------- +! calculate the stress and penalty due to volume discrepancy + vPen = 0.0_pReal + do iGrain = 1_pInt,nGrain + vPen(:,:,iGrain) = -1.0_pReal/real(nGrain,pReal)*volDiscrMod_RGC*volDiscrPow_RGC/maxVolDiscr_RGC* & + sign((abs(vDiscrep)/maxVolDiscr_RGC)**(volDiscrPow_RGC - 1.0),vDiscrep)* & + gVol(iGrain)*transpose(math_inv33(fDef(:,:,iGrain))) + +!-------------------------------------------------------------------------------------------------- +! debugging the stress-like penalty + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30,i2)')'Volume penalty of grain: ',iGrain + do i = 1,3 + write(6,'(1x,3(e11.4,1x))')(vPen(i,j,iGrain), j = 1,3) + enddo + !$OMP END CRITICAL (write2out) + endif + enddo + +end subroutine homogenization_RGC_volumePenalty + + +!-------------------------------------------------------------------------------------------------- +!> @brief compute the correction factor accouted for surface evolution (area change) due to +! deformation +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_surfaceCorrection(avgF,ip,el) + use math, only: & + math_invert33, & + math_mul33x33 + + implicit none + real(pReal), dimension(3) :: homogenization_RGC_surfaceCorrection + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + integer(pInt), intent(in) :: ip,& !< integration point number + el !< element number + real(pReal), dimension(3,3) :: invC,avgC + real(pReal), dimension(3) :: nVect + real(pReal) :: detF + integer(pInt), dimension(4) :: intFace + integer(pInt) :: i,j,iBase + logical :: error + + avgC = math_mul33x33(transpose(avgF),avgF) + call math_invert33(avgC,invC,detF,error) + homogenization_RGC_surfaceCorrection = 0.0_pReal + do iBase = 1_pInt,3_pInt + intFace = [iBase,1_pInt,1_pInt,1_pInt] + nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) ! get the normal of the interface + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt + homogenization_RGC_surfaceCorrection(iBase) = & ! compute the component of (the inverse of) the stretch in the direction of the normal + homogenization_RGC_surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) + enddo; enddo + homogenization_RGC_surfaceCorrection(iBase) = & ! get the surface correction factor (area contraction/enlargement) + sqrt(homogenization_RGC_surfaceCorrection(iBase))*detF + enddo + +end function homogenization_RGC_surfaceCorrection + + +!-------------------------------------------------------------------------------------------------- +!> @brief compute the equivalent shear and bulk moduli from the elasticity tensor +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_equivalentModuli(grainID,ip,el) + use constitutive, only: & + constitutive_homogenizedC + + implicit none + integer(pInt), intent(in) :: & + grainID,& + ip, & !< integration point number + el !< element number + real(pReal), dimension (6,6) :: elasTens + real(pReal), dimension(2) :: homogenization_RGC_equivalentModuli + real(pReal) :: & + cEquiv_11, & + cEquiv_12, & + cEquiv_44 + + elasTens = constitutive_homogenizedC(grainID,ip,el) + +!-------------------------------------------------------------------------------------------------- +! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005) + cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal + cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & + elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal + cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal + homogenization_RGC_equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 + +!-------------------------------------------------------------------------------------------------- +! obtain the length of Burgers vector (could be model dependend) + homogenization_RGC_equivalentModuli(2) = 2.5e-10_pReal + +end function homogenization_RGC_equivalentModuli + + +!-------------------------------------------------------------------------------------------------- +!> @brief collect relaxation vectors of an interface +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_relaxationVector(intFace,homID, ip, el) + use material, only: & + homogState, & + mappingHomogenization + + implicit none + integer(pInt), intent(in) :: ip, el + real(pReal), dimension (3) :: homogenization_RGC_relaxationVector + integer(pInt), dimension (4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) + integer(pInt), dimension (3) :: nGDim + integer(pInt) :: & + iNum, & + homID !< homogenization ID + +!-------------------------------------------------------------------------------------------------- +! collect the interface relaxation vector from the global state array + homogenization_RGC_relaxationVector = 0.0_pReal + nGDim = homogenization_RGC_Ngrains(1:3,homID) + iNum = homogenization_RGC_interface4to1(intFace,homID) ! identify the position of the interface in global state array + if (iNum > 0_pInt) homogenization_RGC_relaxationVector = homogState(mappingHomogenization(2,ip,el))% & + state((3*iNum-2):(3*iNum),mappingHomogenization(1,ip,el)) ! get the corresponding entries + +end function homogenization_RGC_relaxationVector + + +!-------------------------------------------------------------------------------------------------- +!> @brief identify the normal of an interface +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_interfaceNormal(intFace,ip,el) + use debug, only: & + debug_homogenization,& + debug_levelExtensive + use math, only: & + math_mul33x3 + + implicit none + real(pReal), dimension (3) :: homogenization_RGC_interfaceNormal + integer(pInt), dimension (4), intent(in) :: intFace !< interface ID in 4D array (normal and position) + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + integer(pInt) :: nPos + +!-------------------------------------------------------------------------------------------------- +! get the normal of the interface, identified from the value of intFace(1) + homogenization_RGC_interfaceNormal = 0.0_pReal + nPos = abs(intFace(1)) ! identify the position of the interface in global state array + homogenization_RGC_interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis + + homogenization_RGC_interfaceNormal = & + math_mul33x3(homogenization_RGC_orientation(1:3,1:3,ip,el),homogenization_RGC_interfaceNormal) + ! map the normal vector into sample coordinate system (basis) + +end function homogenization_RGC_interfaceNormal + + +!-------------------------------------------------------------------------------------------------- +!> @brief collect six faces of a grain in 4D (normal and position) +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_getInterface(iFace,iGrain3) + + implicit none + integer(pInt), dimension (4) :: homogenization_RGC_getInterface + integer(pInt), dimension (3), intent(in) :: iGrain3 !< grain ID in 3D array + integer(pInt), intent(in) :: iFace !< face index (1..6) mapped like (-e1,-e2,-e3,+e1,+e2,+e3) or iDir = (-1,-2,-3,1,2,3) + integer(pInt) :: iDir + +!* Direction of interface normal + iDir = (int(real(iFace-1_pInt,pReal)/2.0_pReal,pInt)+1_pInt)*(-1_pInt)**iFace + homogenization_RGC_getInterface(1) = iDir + +!-------------------------------------------------------------------------------------------------- +! identify the interface position by the direction of its normal + homogenization_RGC_getInterface(2:4) = iGrain3 + if (iDir < 0_pInt) & ! to have a correlation with coordinate/position in real space + homogenization_RGC_getInterface(1_pInt-iDir) = homogenization_RGC_getInterface(1_pInt-iDir)-1_pInt + +end function homogenization_RGC_getInterface + +!-------------------------------------------------------------------------------------------------- +!> @brief map grain ID from in 1D (global array) to in 3D (local position) +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_grain1to3(grain1,homID) + + implicit none + integer(pInt), dimension (3) :: homogenization_RGC_grain1to3 + integer(pInt), intent(in) :: & + grain1,& !< grain ID in 1D array + homID !< homogenization ID + integer(pInt), dimension (3) :: nGDim + +!-------------------------------------------------------------------------------------------------- +! get the grain position + nGDim = homogenization_RGC_Ngrains(1:3,homID) + homogenization_RGC_grain1to3(3) = 1_pInt+(grain1-1_pInt)/(nGDim(1)*nGDim(2)) + homogenization_RGC_grain1to3(2) = 1_pInt+mod((grain1-1_pInt)/nGDim(1),nGDim(2)) + homogenization_RGC_grain1to3(1) = 1_pInt+mod((grain1-1_pInt),nGDim(1)) + +end function homogenization_RGC_grain1to3 + + +!-------------------------------------------------------------------------------------------------- +!> @brief map grain ID from in 3D (local position) to in 1D (global array) +!-------------------------------------------------------------------------------------------------- +pure function homogenization_RGC_grain3to1(grain3,homID) + + implicit none + integer(pInt), dimension (3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) + integer(pInt) :: homogenization_RGC_grain3to1 + integer(pInt), dimension (3) :: nGDim + integer(pInt), intent(in) :: homID ! homogenization ID + +!-------------------------------------------------------------------------------------------------- +! get the grain ID + nGDim = homogenization_RGC_Ngrains(1:3,homID) + homogenization_RGC_grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1_pInt) + nGDim(1)*nGDim(2)*(grain3(3)-1_pInt) + +end function homogenization_RGC_grain3to1 + + +!-------------------------------------------------------------------------------------------------- +!> @brief maps interface ID from 4D (normal and local position) into 1D (global array) +!-------------------------------------------------------------------------------------------------- +integer(pInt) pure function homogenization_RGC_interface4to1(iFace4D, homID) + + implicit none + integer(pInt), dimension (4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) + integer(pInt), dimension (3) :: nGDim,nIntFace + integer(pInt), intent(in) :: homID !< homogenization ID + + nGDim = homogenization_RGC_Ngrains(1:3,homID) + +!-------------------------------------------------------------------------------------------------- +! compute the total number of interfaces, which ... + nIntFace(1) = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) ! ... normal //e1 + nIntFace(2) = nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! ... normal //e2 + nIntFace(3) = nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) ! ... normal //e3 + + homogenization_RGC_interface4to1 = -1_pInt + +!-------------------------------------------------------------------------------------------------- +! get the corresponding interface ID in 1D global array + if (abs(iFace4D(1)) == 1_pInt) then ! interface with normal //e1 + homogenization_RGC_interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1_pInt) & + + nGDim(2)*nGDim(3)*(iFace4D(2)-1_pInt) + if ((iFace4D(2) == 0_pInt) .or. (iFace4D(2) == nGDim(1))) homogenization_RGC_interface4to1 = 0_pInt + elseif (abs(iFace4D(1)) == 2_pInt) then ! interface with normal //e2 + homogenization_RGC_interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1_pInt) & + + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) + nIntFace(1) + if ((iFace4D(3) == 0_pInt) .or. (iFace4D(3) == nGDim(2))) homogenization_RGC_interface4to1 = 0_pInt + elseif (abs(iFace4D(1)) == 3_pInt) then ! interface with normal //e3 + homogenization_RGC_interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1_pInt) & + + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) + nIntFace(1) + nIntFace(2) + if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) homogenization_RGC_interface4to1 = 0_pInt + endif + +end function homogenization_RGC_interface4to1 + + +!-------------------------------------------------------------------------------------------------- +!> @brief maps interface ID from 1D (global array) into 4D (normal and local position) +!-------------------------------------------------------------------------------------------------- +function homogenization_RGC_interface1to4(iFace1D, homID) + + implicit none + integer(pInt), dimension (4) :: homogenization_RGC_interface1to4 + integer(pInt), intent(in) :: iFace1D !< interface ID in 1D array + integer(pInt), dimension (3) :: nGDim,nIntFace + integer(pInt), intent(in) :: homID !< homogenization ID + + nGDim = homogenization_RGC_Ngrains(:,homID) + +!-------------------------------------------------------------------------------------------------- +! compute the total number of interfaces, which ... + nIntFace(1) = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) ! ... normal //e1 + nIntFace(2) = nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! ... normal //e2 + nIntFace(3) = nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) ! ... normal //e3 + +!-------------------------------------------------------------------------------------------------- +! get the corresponding interface ID in 4D (normal and local position) + if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal //e1 + homogenization_RGC_interface1to4(1) = 1_pInt + homogenization_RGC_interface1to4(3) = mod((iFace1D-1_pInt),nGDim(2))+1_pInt + homogenization_RGC_interface1to4(4) = mod(& + int(& + real(iFace1D-1_pInt,pReal)/& + real(nGDim(2),pReal)& + ,pInt)& + ,nGDim(3))+1_pInt + homogenization_RGC_interface1to4(2) = int(& + real(iFace1D-1_pInt,pReal)/& + real(nGDim(2),pReal)/& + real(nGDim(3),pReal)& + ,pInt)+1_pInt + elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal //e2 + homogenization_RGC_interface1to4(1) = 2_pInt + homogenization_RGC_interface1to4(4) = mod((iFace1D-nIntFace(1)-1_pInt),nGDim(3))+1_pInt + homogenization_RGC_interface1to4(2) = mod(& + int(& + real(iFace1D-nIntFace(1)-1_pInt,pReal)/& + real(nGDim(3),pReal)& + ,pInt)& + ,nGDim(1))+1_pInt + homogenization_RGC_interface1to4(3) = int(& + real(iFace1D-nIntFace(1)-1_pInt,pReal)/& + real(nGDim(3),pReal)/& + real(nGDim(1),pReal)& + ,pInt)+1_pInt + elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal //e3 + homogenization_RGC_interface1to4(1) = 3_pInt + homogenization_RGC_interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1_pInt),nGDim(1))+1_pInt + homogenization_RGC_interface1to4(3) = mod(& + int(& + real(iFace1D-nIntFace(2)-nIntFace(1)-1_pInt,pReal)/& + real(nGDim(1),pReal)& + ,pInt)& + ,nGDim(2))+1_pInt + homogenization_RGC_interface1to4(4) = int(& + real(iFace1D-nIntFace(2)-nIntFace(1)-1_pInt,pReal)/& + real(nGDim(1),pReal)/& + real(nGDim(2),pReal)& + ,pInt)+1_pInt + endif + +end function homogenization_RGC_interface1to4 + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculating the grain deformation gradient (the same with +! homogenization_RGC_partionDeformation, but used only for perturbation scheme) +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_RGC_grainDeformation(F, avgF, ip, el) + use mesh, only: & + mesh_element + use material, only: & + homogenization_maxNgrains,& + homogenization_Ngrains, & + homogenization_typeInstance + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain + real(pReal), dimension (3,3), intent(in) :: avgF !< + integer(pInt), intent(in) :: & + el, & !< element number + ip !< integration point number + real(pReal), dimension (3) :: aVect,nVect + integer(pInt), dimension (4) :: intFace + integer(pInt), dimension (3) :: iGrain3 + integer(pInt) :: homID, iGrain,iFace,i,j + integer(pInt), parameter :: nFace = 6_pInt + +!-------------------------------------------------------------------------------------------------- +! compute the deformation gradient of individual grains due to relaxations + homID = homogenization_typeInstance(mesh_element(3,el)) + F = 0.0_pReal + do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) + iGrain3 = homogenization_RGC_grain1to3(iGrain,homID) + do iFace = 1_pInt,nFace + intFace = homogenization_RGC_getInterface(iFace,iGrain3) + aVect = homogenization_RGC_relaxationVector(intFace,homID, ip, el) + nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & + F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations + enddo + F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient + enddo + +end subroutine homogenization_RGC_grainDeformation + +end module homogenization_RGC diff --git a/code/homogenization/homogenization_isostrain.f90 b/code/homogenization/homogenization_isostrain.f90 new file mode 100644 index 000000000..083107d9f --- /dev/null +++ b/code/homogenization/homogenization_isostrain.f90 @@ -0,0 +1,317 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Isostrain (full constraint Taylor assuption) homogenization scheme +!-------------------------------------------------------------------------------------------------- +module homogenization_isostrain + use prec, only: & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + homogenization_isostrain_sizePostResults + integer(pInt), dimension(:,:), allocatable, target, public :: & + homogenization_isostrain_sizePostResult + + character(len=64), dimension(:,:), allocatable, target, public :: & + homogenization_isostrain_output !< name of each post result output + integer(pInt), dimension(:), allocatable, target, public :: & + homogenization_isostrain_Noutput !< number of outputs per homog instance + integer(pInt), dimension(:), allocatable, private :: & + homogenization_isostrain_Ngrains + enum, bind(c) + enumerator :: undefined_ID, & + nconstituents_ID, & + ipcoords_ID, & + avgdefgrad_ID, & + avgfirstpiola_ID + end enum + enum, bind(c) + enumerator :: parallel_ID, & + average_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + homogenization_isostrain_outputID !< ID of each post result output + integer(kind(average_ID)), dimension(:), allocatable, private :: & + homogenization_isostrain_mapping !< mapping type + + + public :: & + homogenization_isostrain_init, & + homogenization_isostrain_partitionDeformation, & + homogenization_isostrain_averageStressAndItsTangent, & + homogenization_isostrain_postResults + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, reads information from material configuration file +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_isostrain_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + pReal + use debug, only: & + debug_HOMOGENIZATION, & + debug_level, & + debug_levelBasic + use IO + use material + use numerics, only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + section = 0_pInt, i, mySize, o + integer :: & + maxNinstance, & + homog, & + instance + integer :: & + NofMyHomog ! no pInt (stores a system dependen value from 'count' + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) + if (maxNinstance == 0) return + + if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + allocate(homogenization_isostrain_sizePostResults(maxNinstance), source=0_pInt) + allocate(homogenization_isostrain_sizePostResult(maxval(homogenization_Noutput),maxNinstance), & + source=0_pInt) + allocate(homogenization_isostrain_Noutput(maxNinstance), source=0_pInt) + allocate(homogenization_isostrain_Ngrains(maxNinstance), source=0_pInt) + allocate(homogenization_isostrain_mapping(maxNinstance), source=average_ID) + allocate(homogenization_isostrain_output(maxval(homogenization_Noutput),maxNinstance)) + homogenization_isostrain_output = '' + allocate(homogenization_isostrain_outputID(maxval(homogenization_Noutput),maxNinstance), & + source=undefined_ID) + + rewind(fileUnit) + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homogenization part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next section + section = section + 1_pInt + cycle + endif + if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran + if (homogenization_type(section) == HOMOGENIZATION_ISOSTRAIN_ID) then ! one of my sections + i = homogenization_typeInstance(section) ! which instance of my type is present homogenization + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case('nconstituents','ngrains') + homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt + homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = nconstituents_ID + homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('ipcoords') + homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt + homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = ipcoords_ID + homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('avgdefgrad','avgf') + homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt + homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgdefgrad_ID + homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case('avgp','avgfirstpiola','avg1stpiola') + homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt + homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgfirstpiola_ID + homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + + end select + case ('nconstituents','ngrains') + homogenization_isostrain_Ngrains(i) = IO_intValue(line,chunkPos,2_pInt) + case ('mapping') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('parallel','sum') + homogenization_isostrain_mapping(i) = parallel_ID + case ('average','mean','avg') + homogenization_isostrain_mapping(i) = average_ID + case default + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')') + end select + + end select + endif + endif + enddo parsingFile + + initializeInstances: do homog = 1_pInt, material_Nhomogenization + myHomog: if (homogenization_type(homog) == HOMOGENIZATION_ISOSTRAIN_ID) then + NofMyHomog = count(material_homog == homog) + instance = homogenization_typeInstance(homog) + +! * Determine size of postResults array + outputsLoop: do o = 1_pInt, homogenization_isostrain_Noutput(instance) + select case(homogenization_isostrain_outputID(o,instance)) + case(nconstituents_ID) + mySize = 1_pInt + case(ipcoords_ID) + mySize = 3_pInt + case(avgdefgrad_ID, avgfirstpiola_ID) + mySize = 9_pInt + case default + mySize = 0_pInt + end select + + outputFound: if (mySize > 0_pInt) then + homogenization_isostrain_sizePostResult(o,instance) = mySize + homogenization_isostrain_sizePostResults(instance) = & + homogenization_isostrain_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop + +! allocate state arrays + homogState(homog)%sizeState = 0_pInt + homogState(homog)%sizePostResults = homogenization_isostrain_sizePostResults(instance) + allocate(homogState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) + + endif myHomog + enddo initializeInstances + +end subroutine homogenization_isostrain_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief partitions the deformation gradient onto the constituents +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_isostrain_partitionDeformation(F,avgF,el) + use prec, only: & + pReal + use mesh, only: & + mesh_element + use material, only: & + homogenization_maxNgrains, & + homogenization_Ngrains + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned def grad per grain + real(pReal), dimension (3,3), intent(in) :: avgF !< my average def grad + integer(pInt), intent(in) :: & + el !< element number + F=0.0_pReal + F(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)))= & + spread(avgF,3,homogenization_Ngrains(mesh_element(3,el))) + +end subroutine homogenization_isostrain_partitionDeformation + + +!-------------------------------------------------------------------------------------------------- +!> @brief derive average stress and stiffness from constituent quantities +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,el) + use prec, only: & + pReal + use mesh, only: & + mesh_element + use material, only: & + homogenization_maxNgrains, & + homogenization_Ngrains, & + homogenization_typeInstance + + implicit none + real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point + real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses + real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses + integer(pInt), intent(in) :: el !< element number + integer(pInt) :: & + homID, & + Ngrains + + homID = homogenization_typeInstance(mesh_element(3,el)) + Ngrains = homogenization_Ngrains(mesh_element(3,el)) + + select case (homogenization_isostrain_mapping(homID)) + case (parallel_ID) + avgP = sum(P,3) + dAvgPdAvgF = sum(dPdF,5) + case (average_ID) + avgP = sum(P,3) /real(Ngrains,pReal) + dAvgPdAvgF = sum(dPdF,5)/real(Ngrains,pReal) + end select + +end subroutine homogenization_isostrain_averageStressAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of homogenization results for post file inclusion +!-------------------------------------------------------------------------------------------------- +pure function homogenization_isostrain_postResults(ip,el,avgP,avgF) + use prec, only: & + pReal + use mesh, only: & + mesh_element, & + mesh_ipCoordinates + use material, only: & + homogenization_typeInstance, & + homogenization_Noutput + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3), intent(in) :: & + avgP, & !< average stress at material point + avgF !< average deformation gradient at material point + real(pReal), dimension(homogenization_isostrain_sizePostResults & + (homogenization_typeInstance(mesh_element(3,el)))) :: & + homogenization_isostrain_postResults + + integer(pInt) :: & + homID, & + o, c + + c = 0_pInt + homID = homogenization_typeInstance(mesh_element(3,el)) + homogenization_isostrain_postResults = 0.0_pReal + + do o = 1_pInt,homogenization_Noutput(mesh_element(3,el)) + select case(homogenization_isostrain_outputID(o,homID)) + case (nconstituents_ID) + homogenization_isostrain_postResults(c+1_pInt) = real(homogenization_isostrain_Ngrains(homID),pReal) + c = c + 1_pInt + case (avgdefgrad_ID) + homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(avgF,[9]) + c = c + 9_pInt + case (avgfirstpiola_ID) + homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(avgP,[9]) + c = c + 9_pInt + case (ipcoords_ID) + homogenization_isostrain_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el) ! current ip coordinates + c = c + 3_pInt + end select + enddo + +end function homogenization_isostrain_postResults + +end module homogenization_isostrain diff --git a/code/homogenization/homogenization_none.f90 b/code/homogenization/homogenization_none.f90 new file mode 100644 index 000000000..59e483c27 --- /dev/null +++ b/code/homogenization/homogenization_none.f90 @@ -0,0 +1,60 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief dummy homogenization homogenization scheme +!-------------------------------------------------------------------------------------------------- +module homogenization_none + + implicit none + private + + public :: & + homogenization_none_init + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, reads information from material configuration file +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_none_init() + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + pReal, & + pInt + use IO, only: & + IO_timeStamp + use material + use numerics, only: & + worldrank + + implicit none + integer(pInt) :: & + homog, & + NofMyHomog + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + initializeInstances: do homog = 1_pInt, material_Nhomogenization + + myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then + NofMyHomog = count(material_homog == homog) + homogState(homog)%sizeState = 0_pInt + homogState(homog)%sizePostResults = 0_pInt + allocate(homogState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) + + endif myhomog + enddo initializeInstances + + +end subroutine homogenization_none_init + +end module homogenization_none diff --git a/code/hydrogenflux/CMakeLists.txt b/code/hydrogenflux/CMakeLists.txt new file mode 100644 index 000000000..ef296400b --- /dev/null +++ b/code/hydrogenflux/CMakeLists.txt @@ -0,0 +1,9 @@ +# group sources +set (HYDROGENFLUX "hydrogenflux_isoconc" + "hydrogenflux_cahnhilliard" + ) + +# compile hydrogenflux modules +foreach (p ${HYDROGENFLUX}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) diff --git a/code/hydrogenflux/hydrogenflux_cahnhilliard.f90 b/code/hydrogenflux/hydrogenflux_cahnhilliard.f90 new file mode 100644 index 000000000..d8cb71edc --- /dev/null +++ b/code/hydrogenflux/hydrogenflux_cahnhilliard.f90 @@ -0,0 +1,513 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for conservative transport of solute hydrogen +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module hydrogenflux_cahnhilliard + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + hydrogenflux_cahnhilliard_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + hydrogenflux_cahnhilliard_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + hydrogenflux_cahnhilliard_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + hydrogenflux_cahnhilliard_Noutput !< number of outputs per instance of this damage + + real(pReal), parameter, private :: & + kB = 1.3806488e-23_pReal !< Boltzmann constant in J/Kelvin + + enum, bind(c) + enumerator :: undefined_ID, & + hydrogenConc_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + hydrogenflux_cahnhilliard_outputID !< ID of each post result output + + + public :: & + hydrogenflux_cahnhilliard_init, & + hydrogenflux_cahnhilliard_getMobility33, & + hydrogenflux_cahnhilliard_getDiffusion33, & + hydrogenflux_cahnhilliard_getFormationEnergy, & + hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent, & + hydrogenflux_cahnhilliard_getChemPotAndItsTangent, & + hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate, & + hydrogenflux_cahnhilliard_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine hydrogenflux_cahnhilliard_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + hydrogenflux_type, & + hydrogenflux_typeInstance, & + homogenization_Noutput, & + HYDROGENFLUX_cahnhilliard_label, & + HYDROGENFLUX_cahnhilliard_ID, & + material_homog, & + mappingHomogenization, & + hydrogenfluxState, & + hydrogenfluxMapping, & + hydrogenConc, & + hydrogenConcRate, & + hydrogenflux_initialCh, & + material_partHomogenization, & + material_partPhase + use numerics,only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o + integer(pInt) :: sizeState + integer(pInt) :: NofMyHomog + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt) + if (maxNinstance == 0_pInt) return + + allocate(hydrogenflux_cahnhilliard_sizePostResults(maxNinstance), source=0_pInt) + allocate(hydrogenflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(hydrogenflux_cahnhilliard_output (maxval(homogenization_Noutput),maxNinstance)) + hydrogenflux_cahnhilliard_output = '' + allocate(hydrogenflux_cahnhilliard_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) + allocate(hydrogenflux_cahnhilliard_Noutput (maxNinstance), source=0_pInt) + + rewind(fileUnit) + section = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to + line = IO_read(fileUnit) + enddo + + parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next homog section + section = section + 1_pInt ! advance homog section counter + cycle ! skip to next line + endif + + if (section > 0_pInt ) then; if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = hydrogenflux_typeInstance(section) ! which instance of my hydrogenflux is present homog + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('hydrogenconc') + hydrogenflux_cahnhilliard_Noutput(instance) = hydrogenflux_cahnhilliard_Noutput(instance) + 1_pInt + hydrogenflux_cahnhilliard_outputID(hydrogenflux_cahnhilliard_Noutput(instance),instance) = hydrogenConc_ID + hydrogenflux_cahnhilliard_output(hydrogenflux_cahnhilliard_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + end select + endif; endif + enddo parsingHomog + + rewind(fileUnit) + section = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + initializeInstances: do section = 1_pInt, size(hydrogenflux_type) + if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then + NofMyHomog=count(material_homog==section) + instance = hydrogenflux_typeInstance(section) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance) + select case(hydrogenflux_cahnhilliard_outputID(o,instance)) + case(hydrogenConc_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + hydrogenflux_cahnhilliard_sizePostResult(o,instance) = mySize + hydrogenflux_cahnhilliard_sizePostResults(instance) = hydrogenflux_cahnhilliard_sizePostResults(instance) + mySize + endif + enddo outputsLoop + +! allocate state arrays + sizeState = 0_pInt + hydrogenfluxState(section)%sizeState = sizeState + hydrogenfluxState(section)%sizePostResults = hydrogenflux_cahnhilliard_sizePostResults(instance) + allocate(hydrogenfluxState(section)%state0 (sizeState,NofMyHomog)) + allocate(hydrogenfluxState(section)%subState0(sizeState,NofMyHomog)) + allocate(hydrogenfluxState(section)%state (sizeState,NofMyHomog)) + + nullify(hydrogenfluxMapping(section)%p) + hydrogenfluxMapping(section)%p => mappingHomogenization(1,:,:) + deallocate(hydrogenConc (section)%p) + deallocate(hydrogenConcRate(section)%p) + allocate (hydrogenConc (section)%p(NofMyHomog), source=hydrogenflux_initialCh(section)) + allocate (hydrogenConcRate(section)%p(NofMyHomog), source=0.0_pReal) + + endif + + enddo initializeInstances + +end subroutine hydrogenflux_cahnhilliard_init + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized solute mobility tensor in reference configuration +!-------------------------------------------------------------------------------------------------- +function hydrogenflux_cahnhilliard_getMobility33(ip,el) + use lattice, only: & + lattice_hydrogenfluxMobility33 + use material, only: & + homogenization_Ngrains, & + material_phase + use mesh, only: & + mesh_element + use crystallite, only: & + crystallite_push33ToRef + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + hydrogenflux_cahnhilliard_getMobility33 + integer(pInt) :: & + grain + + hydrogenflux_cahnhilliard_getMobility33 = 0.0_pReal + do grain = 1, homogenization_Ngrains(mesh_element(3,el)) + hydrogenflux_cahnhilliard_getMobility33 = hydrogenflux_cahnhilliard_getMobility33 + & + crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxMobility33(:,:,material_phase(grain,ip,el))) + enddo + + hydrogenflux_cahnhilliard_getMobility33 = & + hydrogenflux_cahnhilliard_getMobility33/ & + homogenization_Ngrains(mesh_element(3,el)) + +end function hydrogenflux_cahnhilliard_getMobility33 + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized solute nonlocal diffusion tensor in reference configuration +!-------------------------------------------------------------------------------------------------- +function hydrogenflux_cahnhilliard_getDiffusion33(ip,el) + use lattice, only: & + lattice_hydrogenfluxDiffusion33 + use material, only: & + homogenization_Ngrains, & + material_phase + use mesh, only: & + mesh_element + use crystallite, only: & + crystallite_push33ToRef + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + hydrogenflux_cahnhilliard_getDiffusion33 + integer(pInt) :: & + grain + + hydrogenflux_cahnhilliard_getDiffusion33 = 0.0_pReal + do grain = 1, homogenization_Ngrains(mesh_element(3,el)) + hydrogenflux_cahnhilliard_getDiffusion33 = hydrogenflux_cahnhilliard_getDiffusion33 + & + crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxDiffusion33(:,:,material_phase(grain,ip,el))) + enddo + + hydrogenflux_cahnhilliard_getDiffusion33 = & + hydrogenflux_cahnhilliard_getDiffusion33/ & + homogenization_Ngrains(mesh_element(3,el)) + +end function hydrogenflux_cahnhilliard_getDiffusion33 + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized solution energy +!-------------------------------------------------------------------------------------------------- +function hydrogenflux_cahnhilliard_getFormationEnergy(ip,el) + use lattice, only: & + lattice_hydrogenFormationEnergy, & + lattice_hydrogenVol, & + lattice_hydrogenSurfaceEnergy + use material, only: & + homogenization_Ngrains, & + material_phase + use mesh, only: & + mesh_element + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal) :: & + hydrogenflux_cahnhilliard_getFormationEnergy + integer(pInt) :: & + grain + + hydrogenflux_cahnhilliard_getFormationEnergy = 0.0_pReal + do grain = 1, homogenization_Ngrains(mesh_element(3,el)) + hydrogenflux_cahnhilliard_getFormationEnergy = hydrogenflux_cahnhilliard_getFormationEnergy + & + lattice_hydrogenFormationEnergy(material_phase(grain,ip,el))/ & + lattice_hydrogenVol(material_phase(grain,ip,el))/ & + lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) + enddo + + hydrogenflux_cahnhilliard_getFormationEnergy = & + hydrogenflux_cahnhilliard_getFormationEnergy/ & + homogenization_Ngrains(mesh_element(3,el)) + +end function hydrogenflux_cahnhilliard_getFormationEnergy + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized hydrogen entropy coefficient +!-------------------------------------------------------------------------------------------------- +function hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el) + use lattice, only: & + lattice_hydrogenVol, & + lattice_hydrogenSurfaceEnergy + use material, only: & + homogenization_Ngrains, & + material_homog, & + material_phase, & + temperature, & + thermalMapping + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal) :: & + hydrogenflux_cahnhilliard_getEntropicCoeff + integer(pInt) :: & + grain + + hydrogenflux_cahnhilliard_getEntropicCoeff = 0.0_pReal + do grain = 1, homogenization_Ngrains(material_homog(ip,el)) + hydrogenflux_cahnhilliard_getEntropicCoeff = hydrogenflux_cahnhilliard_getEntropicCoeff + & + kB/ & + lattice_hydrogenVol(material_phase(grain,ip,el))/ & + lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) + enddo + + hydrogenflux_cahnhilliard_getEntropicCoeff = & + hydrogenflux_cahnhilliard_getEntropicCoeff* & + temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ & + homogenization_Ngrains(material_homog(ip,el)) + +end function hydrogenflux_cahnhilliard_getEntropicCoeff + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized kinematic contribution to chemical potential +!-------------------------------------------------------------------------------------------------- +subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el) + use lattice, only: & + lattice_hydrogenSurfaceEnergy + use material, only: & + homogenization_Ngrains, & + material_homog, & + phase_kinematics, & + phase_Nkinematics, & + material_phase, & + KINEMATICS_hydrogen_strain_ID + use crystallite, only: & + crystallite_Tstar_v, & + crystallite_Fi0, & + crystallite_Fi + use kinematics_hydrogen_strain, only: & + kinematics_hydrogen_strain_ChemPotAndItsTangent + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + Ch + real(pReal), intent(out) :: & + KPot, dKPot_dCh + real(pReal) :: & + my_KPot, my_dKPot_dCh + integer(pInt) :: & + grain, kinematics + + KPot = 0.0_pReal + dKPot_dCh = 0.0_pReal + do grain = 1_pInt,homogenization_Ngrains(material_homog(ip,el)) + do kinematics = 1_pInt, phase_Nkinematics(material_phase(grain,ip,el)) + select case (phase_kinematics(kinematics,material_phase(grain,ip,el))) + case (KINEMATICS_hydrogen_strain_ID) + call kinematics_hydrogen_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCh, & + crystallite_Tstar_v(1:6,grain,ip,el), & + crystallite_Fi0(1:3,1:3,grain,ip,el), & + crystallite_Fi (1:3,1:3,grain,ip,el), & + grain,ip, el) + + case default + my_KPot = 0.0_pReal + my_dKPot_dCh = 0.0_pReal + + end select + KPot = KPot + my_KPot/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) + dKPot_dCh = dKPot_dCh + my_dKPot_dCh/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) + enddo + enddo + + KPot = KPot/homogenization_Ngrains(material_homog(ip,el)) + dKPot_dCh = dKPot_dCh/homogenization_Ngrains(material_homog(ip,el)) + +end subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized chemical potential +!-------------------------------------------------------------------------------------------------- +subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCh,Ch,ip,el) + use numerics, only: & + hydrogenBoundPenalty, & + hydrogenPolyOrder + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + Ch + real(pReal), intent(out) :: & + ChemPot, & + dChemPot_dCh + real(pReal) :: & + kBT, KPot, dKPot_dCh + integer(pInt) :: & + o + + ChemPot = hydrogenflux_cahnhilliard_getFormationEnergy(ip,el) + dChemPot_dCh = 0.0_pReal + kBT = hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el) + do o = 1_pInt, hydrogenPolyOrder + ChemPot = ChemPot + kBT*((2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ & + real(2_pInt*o-1_pInt,pReal) + dChemPot_dCh = dChemPot_dCh + 2.0_pReal*kBT*(2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal) + enddo + + call hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el) + ChemPot = ChemPot + KPot + dChemPot_dCh = dChemPot_dCh + dKPot_dCh + + if (Ch < 0.0_pReal) then + ChemPot = ChemPot - 3.0_pReal*hydrogenBoundPenalty*Ch*Ch + dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*Ch + elseif (Ch > 1.0_pReal) then + ChemPot = ChemPot + 3.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch)*(1.0_pReal - Ch) + dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch) + endif + +end subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief updates hydrogen concentration with solution from Cahn-Hilliard PDE for solute transport +!-------------------------------------------------------------------------------------------------- +subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate(Ch,Chdot,ip,el) + use material, only: & + mappingHomogenization, & + hydrogenConc, & + hydrogenConcRate, & + hydrogenfluxMapping + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + Ch, & + Chdot + integer(pInt) :: & + homog, & + offset + + homog = mappingHomogenization(2,ip,el) + offset = hydrogenfluxMapping(homog)%p(ip,el) + hydrogenConc (homog)%p(offset) = Ch + hydrogenConcRate(homog)%p(offset) = Chdot + +end subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of hydrogen transport results +!-------------------------------------------------------------------------------------------------- +function hydrogenflux_cahnhilliard_postResults(ip,el) + use material, only: & + mappingHomogenization, & + hydrogenflux_typeInstance, & + hydrogenConc, & + hydrogenfluxMapping + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element + real(pReal), dimension(hydrogenflux_cahnhilliard_sizePostResults(hydrogenflux_typeInstance(mappingHomogenization(2,ip,el)))) :: & + hydrogenflux_cahnhilliard_postResults + + integer(pInt) :: & + instance, homog, offset, o, c + + homog = mappingHomogenization(2,ip,el) + offset = hydrogenfluxMapping(homog)%p(ip,el) + instance = hydrogenflux_typeInstance(homog) + + c = 0_pInt + hydrogenflux_cahnhilliard_postResults = 0.0_pReal + + do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance) + select case(hydrogenflux_cahnhilliard_outputID(o,instance)) + + case (hydrogenConc_ID) + hydrogenflux_cahnhilliard_postResults(c+1_pInt) = hydrogenConc(homog)%p(offset) + c = c + 1 + end select + enddo +end function hydrogenflux_cahnhilliard_postResults + +end module hydrogenflux_cahnhilliard diff --git a/code/hydrogenflux/hydrogenflux_isoconc.f90 b/code/hydrogenflux/hydrogenflux_isoconc.f90 new file mode 100644 index 000000000..74759d4c3 --- /dev/null +++ b/code/hydrogenflux/hydrogenflux_isoconc.f90 @@ -0,0 +1,63 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for constant hydrogen concentration +!-------------------------------------------------------------------------------------------------- +module hydrogenflux_isoconc + + implicit none + private + + public :: & + hydrogenflux_isoconc_init + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, reads information from material configuration file +!-------------------------------------------------------------------------------------------------- +subroutine hydrogenflux_isoconc_init() + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + pReal, & + pInt + use IO, only: & + IO_timeStamp + use material + use numerics, only: & + worldrank + + implicit none + integer(pInt) :: & + homog, & + NofMyHomog + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + initializeInstances: do homog = 1_pInt, material_Nhomogenization + + myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then + NofMyHomog = count(material_homog == homog) + hydrogenfluxState(homog)%sizeState = 0_pInt + hydrogenfluxState(homog)%sizePostResults = 0_pInt + allocate(hydrogenfluxState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(hydrogenfluxState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) + allocate(hydrogenfluxState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) + + deallocate(hydrogenConc (homog)%p) + deallocate(hydrogenConcRate(homog)%p) + allocate (hydrogenConc (homog)%p(1), source=hydrogenflux_initialCh(homog)) + allocate (hydrogenConcRate(homog)%p(1), source=0.0_pReal) + + endif myhomog + enddo initializeInstances + + +end subroutine hydrogenflux_isoconc_init + +end module hydrogenflux_isoconc diff --git a/code/kinematics/CMakeLists.txt b/code/kinematics/CMakeLists.txt new file mode 100644 index 000000000..17e1a7dd7 --- /dev/null +++ b/code/kinematics/CMakeLists.txt @@ -0,0 +1,12 @@ +# group sources +set (KINEMATICS "kinematics_cleavage_opening" + "kinematics_slipplane_opening" + "kinematics_thermal_expansion" + "kinematics_vacancy_strain" + "kinematics_hydrogen_strain" + ) + +# compile kinamtic modules +foreach (p ${KINEMATICS}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) diff --git a/code/kinematics/kinematics_cleavage_opening.f90 b/code/kinematics/kinematics_cleavage_opening.f90 new file mode 100644 index 000000000..945e2d08a --- /dev/null +++ b/code/kinematics/kinematics_cleavage_opening.f90 @@ -0,0 +1,303 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Luv Sharma, Max-Planck-Institut fŸr Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut fŸr Eisenforschung GmbH +!> @brief material subroutine incorporating kinematics resulting from opening of cleavage planes +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module kinematics_cleavage_opening + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + kinematics_cleavage_opening_sizePostResults, & !< cumulative size of post results + kinematics_cleavage_opening_offset, & !< which kinematics is my current damage mechanism? + kinematics_cleavage_opening_instance !< instance of damage kinematics mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + kinematics_cleavage_opening_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + kinematics_cleavage_opening_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + kinematics_cleavage_opening_Noutput !< number of outputs per instance of this damage + + integer(pInt), dimension(:), allocatable, private :: & + kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems + + integer(pInt), dimension(:,:), allocatable, private :: & + kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family + + real(pReal), dimension(:), allocatable, private :: & + kinematics_cleavage_opening_sdot_0, & + kinematics_cleavage_opening_N + + real(pReal), dimension(:,:), allocatable, private :: & + kinematics_cleavage_opening_critDisp, & + kinematics_cleavage_opening_critLoad + + public :: & + kinematics_cleavage_opening_init, & + kinematics_cleavage_opening_LiAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_cleavage_opening_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_kinematics, & + phase_Nkinematics, & + phase_Noutput, & + KINEMATICS_cleavage_opening_label, & + KINEMATICS_cleavage_opening_ID, & + material_Nphase, & + MATERIAL_partPhase + use numerics,only: & + worldrank + use lattice, only: & + lattice_maxNcleavageFamily, & + lattice_NcleavageSystem + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,kinematics + integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_cleavage_opening_offset(material_Nphase), source=0_pInt) + allocate(kinematics_cleavage_opening_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + kinematics_cleavage_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_cleavage_opening_ID) + do kinematics = 1, phase_Nkinematics(phase) + if (phase_kinematics(kinematics,phase) == kinematics_cleavage_opening_ID) & + kinematics_cleavage_opening_offset(phase) = kinematics + enddo + enddo + + allocate(kinematics_cleavage_opening_sizePostResults(maxNinstance), source=0_pInt) + allocate(kinematics_cleavage_opening_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) + allocate(kinematics_cleavage_opening_output(maxval(phase_Noutput),maxNinstance)) + kinematics_cleavage_opening_output = '' + allocate(kinematics_cleavage_opening_Noutput(maxNinstance), source=0_pInt) + allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt) + allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0_pInt) + allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = kinematics_cleavage_opening_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('anisobrittle_sdot0') + kinematics_cleavage_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('anisobrittle_ratesensitivity') + kinematics_cleavage_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('ncleavage') ! + Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_CleavageFamilies + kinematics_cleavage_opening_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisobrittle_criticaldisplacement') + do j = 1_pInt, Nchunks_CleavageFamilies + kinematics_cleavage_opening_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisobrittle_criticalload') + do j = 1_pInt, Nchunks_CleavageFamilies + kinematics_cleavage_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + end select + endif; endif + enddo parsingFile + +!-------------------------------------------------------------------------------------------------- +! sanity checks + sanityChecks: do phase = 1_pInt, material_Nphase + myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then + instance = kinematics_cleavage_opening_instance(phase) + kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & + min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested + kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) + kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether + if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') + if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') + endif myPhase + enddo sanityChecks + +end subroutine kinematics_cleavage_opening_init + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el) + use prec, only: & + tol_math_check + use material, only: & + phaseAt, phasememberAt, & + material_homog, & + damage, & + damageMapping + use lattice, only: & + lattice_Scleavage, & + lattice_Scleavage_v, & + lattice_maxNcleavageFamily, & + lattice_NcleavageSystem + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(6) :: & + Tstar_v !< 2nd Piola-Kirchhoff stress + real(pReal), intent(out), dimension(3,3) :: & + Ld !< damage velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor) + integer(pInt) :: & + phase, & + constituent, & + instance, & + homog, damageOffset, & + f, i, index_myFamily, k, l, m, n + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit, & + udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = kinematics_cleavage_opening_instance(phase) + homog = material_homog(ip,el) + damageOffset = damageMapping(homog)%p(ip,el) + + Ld = 0.0_pReal + dLd_dTstar3333 = 0.0_pReal + do f = 1_pInt,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family + traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase)) + traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase)) + traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase)) + traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* & + damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) + udotd = & + sign(1.0_pReal,traction_d)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udotd) > tol_math_check) then + Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase) + dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_d) - traction_crit) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,1,index_myFamily+i,phase) + endif + + udott = & + sign(1.0_pReal,traction_t)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udott) > tol_math_check) then + Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase) + dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_t) - traction_crit) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,2,index_myFamily+i,phase) + endif + + udotn = & + sign(1.0_pReal,traction_n)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udotn) > tol_math_check) then + Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase) + dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_n) - traction_crit) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,3,index_myFamily+i,phase) + endif + + enddo + enddo + +end subroutine kinematics_cleavage_opening_LiAndItsTangent + +end module kinematics_cleavage_opening diff --git a/code/kinematics/kinematics_hydrogen_strain.f90 b/code/kinematics/kinematics_hydrogen_strain.f90 new file mode 100644 index 000000000..ceb3b1ef3 --- /dev/null +++ b/code/kinematics/kinematics_hydrogen_strain.f90 @@ -0,0 +1,264 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incorporating kinematics resulting from interstitial hydrogen +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module kinematics_hydrogen_strain + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + kinematics_hydrogen_strain_sizePostResults, & !< cumulative size of post results + kinematics_hydrogen_strain_offset, & !< which kinematics is my current damage mechanism? + kinematics_hydrogen_strain_instance !< instance of damage kinematics mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + kinematics_hydrogen_strain_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + kinematics_hydrogen_strain_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + kinematics_hydrogen_strain_Noutput !< number of outputs per instance of this damage + + real(pReal), dimension(:), allocatable, private :: & + kinematics_hydrogen_strain_coeff + + public :: & + kinematics_hydrogen_strain_init, & + kinematics_hydrogen_strain_initialStrain, & + kinematics_hydrogen_strain_LiAndItsTangent, & + kinematics_hydrogen_strain_ChemPotAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_hydrogen_strain_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_kinematics, & + phase_Nkinematics, & + phase_Noutput, & + KINEMATICS_hydrogen_strain_label, & + KINEMATICS_hydrogen_strain_ID, & + material_Nphase, & + MATERIAL_partPhase + use numerics,only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,kinematics + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_hydrogen_strain_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_hydrogen_strain_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_hydrogen_strain_offset(material_Nphase), source=0_pInt) + allocate(kinematics_hydrogen_strain_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + kinematics_hydrogen_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_hydrogen_strain_ID) + do kinematics = 1, phase_Nkinematics(phase) + if (phase_kinematics(kinematics,phase) == kinematics_hydrogen_strain_ID) & + kinematics_hydrogen_strain_offset(phase) = kinematics + enddo + enddo + + allocate(kinematics_hydrogen_strain_sizePostResults(maxNinstance), source=0_pInt) + allocate(kinematics_hydrogen_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(kinematics_hydrogen_strain_output(maxval(phase_Noutput),maxNinstance)) + kinematics_hydrogen_strain_output = '' + allocate(kinematics_hydrogen_strain_Noutput(maxNinstance), source=0_pInt) + allocate(kinematics_hydrogen_strain_coeff(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_hydrogen_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = kinematics_hydrogen_strain_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('hydrogen_strain_coeff') + kinematics_hydrogen_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + +end subroutine kinematics_hydrogen_strain_init + +!-------------------------------------------------------------------------------------------------- +!> @brief report initial hydrogen strain based on current hydrogen conc deviation from +!> equillibrium (0) +!-------------------------------------------------------------------------------------------------- +pure function kinematics_hydrogen_strain_initialStrain(ipc, ip, el) + use math, only: & + math_I3 + use material, only: & + material_phase, & + material_homog, & + hydrogenConc, & + hydrogenfluxMapping + use lattice, only: & + lattice_equilibriumHydrogenConcentration + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + kinematics_hydrogen_strain_initialStrain !< initial thermal strain (should be small strain, though) + integer(pInt) :: & + phase, & + homog, offset, instance + + phase = material_phase(ipc,ip,el) + instance = kinematics_hydrogen_strain_instance(phase) + homog = material_homog(ip,el) + offset = hydrogenfluxMapping(homog)%p(ip,el) + + kinematics_hydrogen_strain_initialStrain = & + (hydrogenConc(homog)%p(offset) - lattice_equilibriumHydrogenConcentration(phase)) * & + kinematics_hydrogen_strain_coeff(instance)* math_I3 + +end function kinematics_hydrogen_strain_initialStrain + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_hydrogen_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el) + use material, only: & + material_phase, & + material_homog, & + hydrogenConc, & + hydrogenConcRate, & + hydrogenfluxMapping + use math, only: & + math_I3 + use lattice, only: & + lattice_equilibriumHydrogenConcentration + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out), dimension(3,3) :: & + Li !< thermal velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor) + integer(pInt) :: & + phase, & + instance, & + homog, offset + real(pReal) :: & + Ch, ChEq, ChDot + + phase = material_phase(ipc,ip,el) + instance = kinematics_hydrogen_strain_instance(phase) + homog = material_homog(ip,el) + offset = hydrogenfluxMapping(homog)%p(ip,el) + Ch = hydrogenConc(homog)%p(offset) + ChDot = hydrogenConcRate(homog)%p(offset) + ChEq = lattice_equilibriumHydrogenConcentration(phase) + + Li = ChDot*math_I3* & + kinematics_hydrogen_strain_coeff(instance)/ & + (1.0_pReal + kinematics_hydrogen_strain_coeff(instance)*(Ch - ChEq)) + dLi_dTstar3333 = 0.0_pReal + +end subroutine kinematics_hydrogen_strain_LiAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the kinematic contribution to hydrogen chemical potential +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCh, Tstar_v, Fi0, Fi, ipc, ip, el) + use material, only: & + material_phase + use math, only: & + math_inv33, & + math_mul33x33, & + math_Mandel6to33, & + math_transpose33 + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(6) :: & + Tstar_v + real(pReal), intent(in), dimension(3,3) :: & + Fi0, Fi + real(pReal), intent(out) :: & + ChemPot, dChemPot_dCh + integer(pInt) :: & + phase, & + instance + + phase = material_phase(ipc,ip,el) + instance = kinematics_hydrogen_strain_instance(phase) + + ChemPot = -kinematics_hydrogen_strain_coeff(instance)* & + sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* & + math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi)) + dChemPot_dCh = 0.0_pReal + +end subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent + +end module kinematics_hydrogen_strain diff --git a/code/kinematics/kinematics_slipplane_opening.f90 b/code/kinematics/kinematics_slipplane_opening.f90 new file mode 100644 index 000000000..8b49e1cf3 --- /dev/null +++ b/code/kinematics/kinematics_slipplane_opening.f90 @@ -0,0 +1,323 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incorporating kinematics resulting from opening of slip planes +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module kinematics_slipplane_opening + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + kinematics_slipplane_opening_sizePostResults, & !< cumulative size of post results + kinematics_slipplane_opening_offset, & !< which kinematics is my current damage mechanism? + kinematics_slipplane_opening_instance !< instance of damage kinematics mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + kinematics_slipplane_opening_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + kinematics_slipplane_opening_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + kinematics_slipplane_opening_Noutput !< number of outputs per instance of this damage + + integer(pInt), dimension(:), allocatable, private :: & + kinematics_slipplane_opening_totalNslip !< total number of slip systems + + integer(pInt), dimension(:,:), allocatable, private :: & + kinematics_slipplane_opening_Nslip !< number of slip systems per family + + real(pReal), dimension(:), allocatable, private :: & + kinematics_slipplane_opening_sdot_0, & + kinematics_slipplane_opening_N + + real(pReal), dimension(:,:), allocatable, private :: & + kinematics_slipplane_opening_critPlasticStrain, & + kinematics_slipplane_opening_critLoad + + public :: & + kinematics_slipplane_opening_init, & + kinematics_slipplane_opening_LiAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_slipplane_opening_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_kinematics, & + phase_Nkinematics, & + phase_Noutput, & + KINEMATICS_slipplane_opening_label, & + KINEMATICS_slipplane_opening_ID, & + material_Nphase, & + MATERIAL_partPhase + use numerics,only: & + worldrank + use lattice, only: & + lattice_maxNslipFamily, & + lattice_NslipSystem + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,kinematics + integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_slipplane_opening_offset(material_Nphase), source=0_pInt) + allocate(kinematics_slipplane_opening_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + kinematics_slipplane_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_slipplane_opening_ID) + do kinematics = 1, phase_Nkinematics(phase) + if (phase_kinematics(kinematics,phase) == kinematics_slipplane_opening_ID) & + kinematics_slipplane_opening_offset(phase) = kinematics + enddo + enddo + + allocate(kinematics_slipplane_opening_sizePostResults(maxNinstance), source=0_pInt) + allocate(kinematics_slipplane_opening_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(kinematics_slipplane_opening_output(maxval(phase_Noutput),maxNinstance)) + kinematics_slipplane_opening_output = '' + allocate(kinematics_slipplane_opening_Noutput(maxNinstance), source=0_pInt) + allocate(kinematics_slipplane_opening_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(kinematics_slipplane_opening_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) + allocate(kinematics_slipplane_opening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(kinematics_slipplane_opening_totalNslip(maxNinstance), source=0_pInt) + allocate(kinematics_slipplane_opening_N(maxNinstance), source=0.0_pReal) + allocate(kinematics_slipplane_opening_sdot_0(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = kinematics_slipplane_opening_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('nslip') ! + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_SlipFamilies + kinematics_slipplane_opening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisoductile_sdot0') + kinematics_slipplane_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('anisoductile_criticalplasticstrain') + do j = 1_pInt, Nchunks_SlipFamilies + kinematics_slipplane_opening_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisoductile_ratesensitivity') + kinematics_slipplane_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('anisoductile_criticalload') + do j = 1_pInt, Nchunks_SlipFamilies + kinematics_slipplane_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + end select + endif; endif + enddo parsingFile + +!-------------------------------------------------------------------------------------------------- +! sanity checks + sanityChecks: do phase = 1_pInt, material_Nphase + myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then + instance = kinematics_slipplane_opening_instance(phase) + kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = & + min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested + kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance)) + kinematics_slipplane_opening_totalNslip(instance) = sum(kinematics_slipplane_opening_Nslip(:,instance)) + if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') + if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) & + call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') + if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') + endif myPhase + enddo sanityChecks + + +end subroutine kinematics_slipplane_opening_init + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el) + use prec, only: & + tol_math_check + use lattice, only: & + lattice_maxNslipFamily, & + lattice_NslipSystem, & + lattice_sd, & + lattice_st, & + lattice_sn + use material, only: & + phaseAt, phasememberAt, & + material_homog, & + damage, & + damageMapping + use math, only: & + math_Plain3333to99, & + math_I3, & + math_identity4th, & + math_symmetric33, & + math_Mandel33to6, & + math_tensorproduct33, & + math_det33, & + math_mul33x33 + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(6) :: & + Tstar_v !< 2nd Piola-Kirchhoff stress + real(pReal), intent(out), dimension(3,3) :: & + Ld !< damage velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor) + real(pReal), dimension(3,3) :: & + projection_d, projection_t, projection_n !< projection modes 3x3 tensor + real(pReal), dimension(6) :: & + projection_d_v, projection_t_v, projection_n_v !< projection modes 3x3 vector + integer(pInt) :: & + phase, & + constituent, & + instance, & + homog, damageOffset, & + f, i, index_myFamily, k, l, m, n + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit, & + udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = kinematics_slipplane_opening_instance(phase) + homog = material_homog(ip,el) + damageOffset = damageMapping(homog)%p(ip,el) + + Ld = 0.0_pReal + dLd_dTstar3333 = 0.0_pReal + do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,kinematics_slipplane_opening_Nslip(f,instance) ! process each (active) slip system in family + projection_d = math_tensorproduct33(lattice_sd(1:3,index_myFamily+i,phase),& + lattice_sn(1:3,index_myFamily+i,phase)) + projection_t = math_tensorproduct33(lattice_st(1:3,index_myFamily+i,phase),& + lattice_sn(1:3,index_myFamily+i,phase)) + projection_n = math_tensorproduct33(lattice_sn(1:3,index_myFamily+i,phase),& + lattice_sn(1:3,index_myFamily+i,phase)) + + projection_d_v(1:6) = math_Mandel33to6(math_symmetric33(projection_d(1:3,1:3))) + projection_t_v(1:6) = math_Mandel33to6(math_symmetric33(projection_t(1:3,1:3))) + projection_n_v(1:6) = math_Mandel33to6(math_symmetric33(projection_n(1:3,1:3))) + + traction_d = dot_product(Tstar_v,projection_d_v(1:6)) + traction_t = dot_product(Tstar_v,projection_t_v(1:6)) + traction_n = dot_product(Tstar_v,projection_n_v(1:6)) + + traction_crit = kinematics_slipplane_opening_critLoad(f,instance)* & + damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage + + udotd = & + sign(1.0_pReal,traction_d)* & + kinematics_slipplane_opening_sdot_0(instance)* & + (abs(traction_d)/traction_crit - & + abs(traction_d)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance) + if (abs(udotd) > tol_math_check) then + Ld = Ld + udotd*projection_d + dudotd_dt = udotd*kinematics_slipplane_opening_N(instance)/traction_d + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dudotd_dt*projection_d(k,l)*projection_d(m,n) + endif + + udott = & + sign(1.0_pReal,traction_t)* & + kinematics_slipplane_opening_sdot_0(instance)* & + (abs(traction_t)/traction_crit - & + abs(traction_t)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance) + if (abs(udott) > tol_math_check) then + Ld = Ld + udott*projection_t + dudott_dt = udott*kinematics_slipplane_opening_N(instance)/traction_t + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dudott_dt*projection_t(k,l)*projection_t(m,n) + endif + udotn = & + kinematics_slipplane_opening_sdot_0(instance)* & + (max(0.0_pReal,traction_n)/traction_crit - & + max(0.0_pReal,traction_n)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance) + if (abs(udotn) > tol_math_check) then + Ld = Ld + udotn*projection_n + dudotn_dt = udotn*kinematics_slipplane_opening_N(instance)/traction_n + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dudotn_dt*projection_n(k,l)*projection_n(m,n) + endif + enddo + enddo + +end subroutine kinematics_slipplane_opening_LiAndItsTangent + +end module kinematics_slipplane_opening diff --git a/code/kinematics/kinematics_thermal_expansion.f90 b/code/kinematics/kinematics_thermal_expansion.f90 new file mode 100644 index 000000000..b99c499f3 --- /dev/null +++ b/code/kinematics/kinematics_thermal_expansion.f90 @@ -0,0 +1,228 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incorporating kinematics resulting from thermal expansion +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module kinematics_thermal_expansion + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + kinematics_thermal_expansion_sizePostResults, & !< cumulative size of post results + kinematics_thermal_expansion_offset, & !< which kinematics is my current damage mechanism? + kinematics_thermal_expansion_instance !< instance of damage kinematics mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + kinematics_thermal_expansion_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + kinematics_thermal_expansion_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage + +! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult +! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output +! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... +! end enum + public :: & + kinematics_thermal_expansion_init, & + kinematics_thermal_expansion_initialStrain, & + kinematics_thermal_expansion_LiAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_thermal_expansion_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_kinematics, & + phase_Nkinematics, & + phase_Noutput, & + KINEMATICS_thermal_expansion_label, & + KINEMATICS_thermal_expansion_ID, & + material_Nphase, & + MATERIAL_partPhase + use numerics,only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,kinematics + character(len=65536) :: & + tag = '', & + output = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_thermal_expansion_offset(material_Nphase), source=0_pInt) + allocate(kinematics_thermal_expansion_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + kinematics_thermal_expansion_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_thermal_expansion_ID) + do kinematics = 1, phase_Nkinematics(phase) + if (phase_kinematics(kinematics,phase) == kinematics_thermal_expansion_ID) & + kinematics_thermal_expansion_offset(phase) = kinematics + enddo + enddo + + allocate(kinematics_thermal_expansion_sizePostResults(maxNinstance), source=0_pInt) + allocate(kinematics_thermal_expansion_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(kinematics_thermal_expansion_output(maxval(phase_Noutput),maxNinstance)) + kinematics_thermal_expansion_output = '' + allocate(kinematics_thermal_expansion_Noutput(maxNinstance), source=0_pInt) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_thermal_expansion_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = kinematics_thermal_expansion_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key... + select case(tag) +! case ('(output)') +! output = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) ! ...and corresponding output +! select case(output) +! case ('thermalexpansionrate') +! kinematics_thermal_expansion_Noutput(instance) = kinematics_thermal_expansion_Noutput(instance) + 1_pInt +! kinematics_thermal_expansion_outputID(kinematics_thermal_expansion_Noutput(instance),instance) = & +! thermalexpansionrate_ID +! kinematics_thermal_expansion_output(kinematics_thermal_expansion_Noutput(instance),instance) = output +! ToDo add sizePostResult loop afterwards... + + end select + endif; endif + enddo parsingFile + +end subroutine kinematics_thermal_expansion_init + +!-------------------------------------------------------------------------------------------------- +!> @brief report initial thermal strain based on current temperature deviation from reference +!-------------------------------------------------------------------------------------------------- +pure function kinematics_thermal_expansion_initialStrain(ipc, ip, el) + use material, only: & + material_phase, & + material_homog, & + temperature, & + thermalMapping + use lattice, only: & + lattice_thermalExpansion33, & + lattice_referenceTemperature + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + kinematics_thermal_expansion_initialStrain !< initial thermal strain (should be small strain, though) + integer(pInt) :: & + phase, & + homog, offset + + phase = material_phase(ipc,ip,el) + homog = material_homog(ip,el) + offset = thermalMapping(homog)%p(ip,el) + + kinematics_thermal_expansion_initialStrain = & + (temperature(homog)%p(offset) - lattice_referenceTemperature(phase)) * & + lattice_thermalExpansion33(1:3,1:3,phase) + +end function kinematics_thermal_expansion_initialStrain + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el) + use material, only: & + material_phase, & + material_homog, & + temperature, & + temperatureRate, & + thermalMapping + use lattice, only: & + lattice_thermalExpansion33, & + lattice_referenceTemperature + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out), dimension(3,3) :: & + Li !< thermal velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) + integer(pInt) :: & + phase, & + homog, offset + real(pReal) :: & + T, TRef, TDot + + phase = material_phase(ipc,ip,el) + homog = material_homog(ip,el) + offset = thermalMapping(homog)%p(ip,el) + T = temperature(homog)%p(offset) + TDot = temperatureRate(homog)%p(offset) + TRef = lattice_referenceTemperature(phase) + + Li = TDot* & + lattice_thermalExpansion33(1:3,1:3,phase)/ & + (1.0_pReal + lattice_thermalExpansion33(1:3,1:3,phase)*(T - TRef)) + dLi_dTstar3333 = 0.0_pReal + +end subroutine kinematics_thermal_expansion_LiAndItsTangent + +end module kinematics_thermal_expansion diff --git a/code/kinematics/kinematics_vacancy_strain.f90 b/code/kinematics/kinematics_vacancy_strain.f90 new file mode 100644 index 000000000..899bccd9f --- /dev/null +++ b/code/kinematics/kinematics_vacancy_strain.f90 @@ -0,0 +1,265 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incorporating kinematics resulting from vacancy point defects +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module kinematics_vacancy_strain + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + kinematics_vacancy_strain_sizePostResults, & !< cumulative size of post results + kinematics_vacancy_strain_offset, & !< which kinematics is my current damage mechanism? + kinematics_vacancy_strain_instance !< instance of damage kinematics mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + kinematics_vacancy_strain_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + kinematics_vacancy_strain_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + kinematics_vacancy_strain_Noutput !< number of outputs per instance of this damage + + real(pReal), dimension(:), allocatable, private :: & + kinematics_vacancy_strain_coeff + + public :: & + kinematics_vacancy_strain_init, & + kinematics_vacancy_strain_initialStrain, & + kinematics_vacancy_strain_LiAndItsTangent, & + kinematics_vacancy_strain_ChemPotAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_vacancy_strain_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_kinematics, & + phase_Nkinematics, & + phase_Noutput, & + KINEMATICS_vacancy_strain_label, & + KINEMATICS_vacancy_strain_ID, & + material_Nphase, & + MATERIAL_partPhase + use numerics,only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,kinematics + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_vacancy_strain_offset(material_Nphase), source=0_pInt) + allocate(kinematics_vacancy_strain_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + kinematics_vacancy_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_vacancy_strain_ID) + do kinematics = 1, phase_Nkinematics(phase) + if (phase_kinematics(kinematics,phase) == kinematics_vacancy_strain_ID) & + kinematics_vacancy_strain_offset(phase) = kinematics + enddo + enddo + + allocate(kinematics_vacancy_strain_sizePostResults(maxNinstance), source=0_pInt) + allocate(kinematics_vacancy_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(kinematics_vacancy_strain_output(maxval(phase_Noutput),maxNinstance)) + kinematics_vacancy_strain_output = '' + allocate(kinematics_vacancy_strain_Noutput(maxNinstance), source=0_pInt) + allocate(kinematics_vacancy_strain_coeff(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_vacancy_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = kinematics_vacancy_strain_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('vacancy_strain_coeff') + kinematics_vacancy_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + +end subroutine kinematics_vacancy_strain_init + +!-------------------------------------------------------------------------------------------------- +!> @brief report initial vacancy strain based on current vacancy conc deviation from equillibrium +!-------------------------------------------------------------------------------------------------- +pure function kinematics_vacancy_strain_initialStrain(ipc, ip, el) + use math, only: & + math_I3 + use material, only: & + material_phase, & + material_homog, & + vacancyConc, & + vacancyfluxMapping + use lattice, only: & + lattice_equilibriumVacancyConcentration + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + kinematics_vacancy_strain_initialStrain !< initial thermal strain (should be small strain, though) + integer(pInt) :: & + phase, & + homog, offset, instance + + phase = material_phase(ipc,ip,el) + instance = kinematics_vacancy_strain_instance(phase) + homog = material_homog(ip,el) + offset = vacancyfluxMapping(homog)%p(ip,el) + + kinematics_vacancy_strain_initialStrain = & + (vacancyConc(homog)%p(offset) - lattice_equilibriumVacancyConcentration(phase)) * & + kinematics_vacancy_strain_coeff(instance)* math_I3 + +end function kinematics_vacancy_strain_initialStrain + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_vacancy_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el) + use material, only: & + material_phase, & + material_homog, & + vacancyConc, & + vacancyConcRate, & + vacancyfluxMapping + use math, only: & + math_I3 + use lattice, only: & + lattice_equilibriumVacancyConcentration + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out), dimension(3,3) :: & + Li !< thermal velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor) + integer(pInt) :: & + phase, & + instance, & + homog, offset + real(pReal) :: & + Cv, CvEq, CvDot + + phase = material_phase(ipc,ip,el) + instance = kinematics_vacancy_strain_instance(phase) + homog = material_homog(ip,el) + offset = vacancyfluxMapping(homog)%p(ip,el) + + Cv = vacancyConc(homog)%p(offset) + CvDot = vacancyConcRate(homog)%p(offset) + CvEq = lattice_equilibriumvacancyConcentration(phase) + + Li = CvDot*math_I3* & + kinematics_vacancy_strain_coeff(instance)/ & + (1.0_pReal + kinematics_vacancy_strain_coeff(instance)*(Cv - CvEq)) + + dLi_dTstar3333 = 0.0_pReal + +end subroutine kinematics_vacancy_strain_LiAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the kinematic contribution to vacancy chemical potential +!-------------------------------------------------------------------------------------------------- +subroutine kinematics_vacancy_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCv, Tstar_v, Fi0, Fi, ipc, ip, el) + use material, only: & + material_phase + use math, only: & + math_inv33, & + math_mul33x33, & + math_Mandel6to33, & + math_transpose33 + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(6) :: & + Tstar_v + real(pReal), intent(in), dimension(3,3) :: & + Fi0, Fi + real(pReal), intent(out) :: & + ChemPot, dChemPot_dCv + integer(pInt) :: & + phase, & + instance + + phase = material_phase(ipc,ip,el) + instance = kinematics_vacancy_strain_instance(phase) + + ChemPot = -kinematics_vacancy_strain_coeff(instance)* & + sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* & + math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi)) + dChemPot_dCv = 0.0_pReal + +end subroutine kinematics_vacancy_strain_ChemPotAndItsTangent + +end module kinematics_vacancy_strain diff --git a/code/plastic/CMakeLists.txt b/code/plastic/CMakeLists.txt new file mode 100644 index 000000000..6c65481c3 --- /dev/null +++ b/code/plastic/CMakeLists.txt @@ -0,0 +1,16 @@ +# group sources +set (PLASTIC "plastic_dislotwin" + "plastic_disloUCLA" + "plastic_isotropic" + "plastic_j2" + "plastic_phenopowerlaw" + "plastic_titanmod" + "plastic_nonlocal" + "plastic_none" + "plastic_phenoplus" + ) + +# compile module +foreach (p ${PLASTIC}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) diff --git a/code/plastic/plastic_disloUCLA.f90 b/code/plastic/plastic_disloUCLA.f90 new file mode 100644 index 000000000..d95a5e6a4 --- /dev/null +++ b/code/plastic/plastic_disloUCLA.f90 @@ -0,0 +1,2116 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author David Cereceda, Lawrence Livermore National Laboratory +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incoprorating dislocation and twinning physics +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module plastic_disloUCLA + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_disloUCLA_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_disloUCLA_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_disloUCLA_output !< name of each post result output + + real(pReal), parameter, private :: & + kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_disloUCLA_Noutput !< number of outputs per instance of this plasticity + + integer(pInt), dimension(:), allocatable, private :: & + plastic_disloUCLA_totalNslip, & !< total number of active slip systems for each instance + plastic_disloUCLA_totalNtwin !< total number of active twin systems for each instance + + integer(pInt), dimension(:,:), allocatable, private :: & + plastic_disloUCLA_Nslip, & !< number of active slip systems for each family and instance + plastic_disloUCLA_Ntwin !< number of active twin systems for each family and instance + + real(pReal), dimension(:), allocatable, private :: & + plastic_disloUCLA_CAtomicVolume, & !< atomic volume in Bugers vector unit + plastic_disloUCLA_D0, & !< prefactor for self-diffusion coefficient + plastic_disloUCLA_Qsd, & !< activation energy for dislocation climb + plastic_disloUCLA_GrainSize, & !< grain size + plastic_disloUCLA_MaxTwinFraction, & !< maximum allowed total twin volume fraction + plastic_disloUCLA_CEdgeDipMinDistance, & !< + plastic_disloUCLA_Cmfptwin, & !< + plastic_disloUCLA_Cthresholdtwin, & !< + plastic_disloUCLA_SolidSolutionStrength, & !< Strength due to elements in solid solution + plastic_disloUCLA_L0, & !< Length of twin nuclei in Burgers vectors + plastic_disloUCLA_xc, & !< critical distance for formation of twin nucleus + plastic_disloUCLA_VcrossSlip, & !< cross slip volume + plastic_disloUCLA_SFE_0K, & !< stacking fault energy at zero K + plastic_disloUCLA_dSFE_dT, & !< temperature dependance of stacking fault energy + plastic_disloUCLA_dipoleFormationFactor, & !< scaling factor for dipole formation: 0: off, 1: on. other values not useful + plastic_disloUCLA_aTolRho, & !< absolute tolerance for integration of dislocation density + plastic_disloUCLA_aTolTwinFrac !< absolute tolerance for integration of twin volume fraction + + real(pReal), dimension(:,:,:,:), allocatable, private :: & + plastic_disloUCLA_Ctwin66 !< twin elasticity matrix in Mandel notation for each instance + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & + plastic_disloUCLA_Ctwin3333 !< twin elasticity matrix for each instance + real(pReal), dimension(:,:), allocatable, private :: & + plastic_disloUCLA_rhoEdge0, & !< initial edge dislocation density per slip system for each family and instance + plastic_disloUCLA_rhoEdgeDip0, & !< initial edge dipole density per slip system for each family and instance + plastic_disloUCLA_burgersPerSlipFamily, & !< absolute length of burgers vector [m] for each slip family and instance + plastic_disloUCLA_burgersPerSlipSystem, & !< absolute length of burgers vector [m] for each slip system and instance + plastic_disloUCLA_burgersPerTwinFamily, & !< absolute length of burgers vector [m] for each twin family and instance + plastic_disloUCLA_burgersPerTwinSystem, & !< absolute length of burgers vector [m] for each twin system and instance + plastic_disloUCLA_QedgePerSlipFamily, & !< activation energy for glide [J] for each slip family and instance + plastic_disloUCLA_QedgePerSlipSystem, & !< activation energy for glide [J] for each slip system and instance + plastic_disloUCLA_v0PerSlipFamily, & !< dislocation velocity prefactor [m/s] for each family and instance + plastic_disloUCLA_v0PerSlipSystem, & !< dislocation velocity prefactor [m/s] for each slip system and instance + plastic_disloUCLA_tau_peierlsPerSlipFamily, & !< Peierls stress [Pa] for each family and instance + plastic_disloUCLA_Ndot0PerTwinFamily, & !< twin nucleation rate [1/m³s] for each twin family and instance + plastic_disloUCLA_Ndot0PerTwinSystem, & !< twin nucleation rate [1/m³s] for each twin system and instance + plastic_disloUCLA_tau_r, & !< stress to bring partial close together for each twin system and instance + plastic_disloUCLA_twinsizePerTwinFamily, & !< twin thickness [m] for each twin family and instance + plastic_disloUCLA_twinsizePerTwinSystem, & !< twin thickness [m] for each twin system and instance + plastic_disloUCLA_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance + plastic_disloUCLA_CLambdaSlipPerSlipSystem, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + plastic_disloUCLA_interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance + plastic_disloUCLA_interaction_SlipTwin, & !< coefficients for slip-twin interaction for each interaction type and instance + plastic_disloUCLA_interaction_TwinSlip, & !< coefficients for twin-slip interaction for each interaction type and instance + plastic_disloUCLA_interaction_TwinTwin, & !< coefficients for twin-twin interaction for each interaction type and instance + plastic_disloUCLA_pPerSlipFamily, & !< p-exponent in glide velocity + plastic_disloUCLA_qPerSlipFamily, & !< q-exponent in glide velocity + !* mobility law parameters + plastic_disloUCLA_kinkheight, & !< height of the kink pair + plastic_disloUCLA_omega, & !< attempt frequency for kink pair nucleation + plastic_disloUCLA_kinkwidth, & !< width of the kink pair + plastic_disloUCLA_dislolength, & !< dislocation length (lamda) + plastic_disloUCLA_friction, & !< friction coeff. B (kMC) + !* + plastic_disloUCLA_rPerTwinFamily, & !< r-exponent in twin nucleation rate + plastic_disloUCLA_nonSchmidCoeff !< non-Schmid coefficients (bcc) + real(pReal), dimension(:,:,:), allocatable, private :: & + plastic_disloUCLA_interactionMatrix_SlipSlip, & !< interaction matrix of the different slip systems for each instance + plastic_disloUCLA_interactionMatrix_SlipTwin, & !< interaction matrix of slip systems with twin systems for each instance + plastic_disloUCLA_interactionMatrix_TwinSlip, & !< interaction matrix of twin systems with slip systems for each instance + plastic_disloUCLA_interactionMatrix_TwinTwin, & !< interaction matrix of the different twin systems for each instance + plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance + + enum, bind(c) + enumerator :: undefined_ID, & + edge_density_ID, & + dipole_density_ID, & + shear_rate_slip_ID, & + accumulated_shear_slip_ID, & + mfp_slip_ID, & + resolved_stress_slip_ID, & + threshold_stress_slip_ID, & + edge_dipole_distance_ID, & + stress_exponent_ID, & + twin_fraction_ID, & + shear_rate_twin_ID, & + accumulated_shear_twin_ID, & + mfp_twin_ID, & + resolved_stress_twin_ID, & + threshold_stress_twin_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_disloUCLA_outputID !< ID of each post result output + + type, private :: tDisloUCLAState + real(pReal), pointer, dimension(:,:) :: & + rhoEdge, & + rhoEdgeDip, & + accshear_slip, & + twinFraction, & + accshear_twin, & + invLambdaSlip, & + invLambdaSlipTwin, & + invLambdaTwin, & + mfp_slip, & + mfp_twin, & + threshold_stress_slip, & + threshold_stress_twin, & + twinVolume + end type + type(tDisloUCLAState ), allocatable, dimension(:), private :: & + state, & + state0, & + dotState + + public :: & + plastic_disloUCLA_init, & + plastic_disloUCLA_homogenizedC, & + plastic_disloUCLA_microstructure, & + plastic_disloUCLA_LpAndItsTangent, & + plastic_disloUCLA_dotState, & + plastic_disloUCLA_postResults + private :: & + plastic_disloUCLA_stateInit, & + plastic_disloUCLA_aTolState + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_DISLOUCLA_label, & + PLASTICITY_DISLOUCLA_ID, & + material_phase, & + plasticState, & + MATERIAL_partPhase + use lattice + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,maxTotalNtwin,& + f,instance,j,k,l,m,n,o,p,q,r,s,ns,nt, & + Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & + Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & + Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, Nchunks_nonSchmid = 0_pInt, & + offset_slip, index_myFamily, index_otherFamily, & + startIndex, endIndex + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + real(pReal), dimension(:), allocatable :: tempPerSlip, tempPerTwin + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(plastic_disloUCLA_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_disloUCLA_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(plastic_disloUCLA_output(maxval(phase_Noutput),maxNinstance)) + plastic_disloUCLA_output = '' + allocate(plastic_disloUCLA_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(plastic_disloUCLA_Noutput(maxNinstance), source=0_pInt) + allocate(plastic_disloUCLA_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(plastic_disloUCLA_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) + allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) + allocate(plastic_disloUCLA_totalNtwin(maxNinstance), source=0_pInt) + allocate(plastic_disloUCLA_CAtomicVolume(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_D0(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_GrainSize(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_MaxTwinFraction(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_Cmfptwin(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_Cthresholdtwin(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_SolidSolutionStrength(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_L0(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_xc(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_VcrossSlip(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_aTolRho(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_aTolTwinFrac(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_SFE_0K(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_dSFE_dT(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default + allocate(plastic_disloUCLA_rhoEdge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_rhoEdgeDip0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_kinkheight(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_omega(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_kinkwidth(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_dislolength(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_friction(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_burgersPerTwinFamily(lattice_maxNtwinFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_QedgePerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_tau_peierlsPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_disloUCLA_pPerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_qPerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_Ndot0PerTwinFamily(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_twinsizePerTwinFamily(lattice_maxNtwinFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_disloUCLA_rPerTwinFamily(lattice_maxNtwinFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance),source=0.0_pReal) + allocate(plastic_disloUCLA_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), source=0.0_pReal) + + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_DISLOUCLA_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + Nchunks_nonSchmid = lattice_NnonSchmid(phase) + if(allocated(tempPerSlip)) deallocate(tempPerSlip) + if(allocated(tempPerTwin)) deallocate(tempPerTwin) + allocate(tempPerSlip(Nchunks_SlipFamilies)) + allocate(tempPerTwin(Nchunks_TwinFamilies)) + endif + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOUCLA_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('edge_density') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = edge_density_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('dipole_density') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = dipole_density_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_rate_slip','shearrate_slip') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = shear_rate_slip_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulated_shear_slip') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = accumulated_shear_slip_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('mfp_slip') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = mfp_slip_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolved_stress_slip') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = resolved_stress_slip_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('threshold_stress_slip') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = threshold_stress_slip_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('edge_dipole_distance') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = edge_dipole_distance_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('stress_exponent') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = stress_exponent_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('twin_fraction') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = twin_fraction_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_rate_twin','shearrate_twin') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = shear_rate_twin_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulated_shear_twin') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = accumulated_shear_twin_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('mfp_twin') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = mfp_twin_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolved_stress_twin') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = resolved_stress_twin_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('threshold_stress_twin') + plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt + plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = threshold_stress_twin_ID + plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of slip system families + case ('nslip') + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_SlipFamilies + plastic_disloUCLA_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('rhoedge0','rhoedgedip0','slipburgers','qedge','v0','clambdaslip','tau_peierls','p_slip','q_slip',& + 'kink_height','omega','kink_width','dislolength','friction_coeff') + do j = 1_pInt, Nchunks_SlipFamilies + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('rhoedge0') + plastic_disloUCLA_rhoEdge0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('rhoedgedip0') + plastic_disloUCLA_rhoEdgeDip0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('slipburgers') + plastic_disloUCLA_burgersPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('qedge') + plastic_disloUCLA_QedgePerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('v0') + plastic_disloUCLA_v0PerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('clambdaslip') + plastic_disloUCLA_CLambdaSlipPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('tau_peierls') + if (lattice_structure(phase) /= LATTICE_bcc_ID) & + call IO_warning(42_pInt,ext_msg=trim(tag)//' for non-bcc ('//PLASTICITY_DISLOUCLA_label//')') + plastic_disloUCLA_tau_peierlsPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('p_slip') + plastic_disloUCLA_pPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('q_slip') + plastic_disloUCLA_qPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('kink_height') + plastic_disloUCLA_kinkheight(1:Nchunks_SlipFamilies,instance) = & + tempPerSlip(1:Nchunks_SlipFamilies) + case ('omega') + plastic_disloUCLA_omega(1:Nchunks_SlipFamilies,instance) = & + tempPerSlip(1:Nchunks_SlipFamilies) + case ('kink_width') + plastic_disloUCLA_kinkwidth(1:Nchunks_SlipFamilies,instance) = & + tempPerSlip(1:Nchunks_SlipFamilies) + case ('dislolength') + plastic_disloUCLA_dislolength(1:Nchunks_SlipFamilies,instance) = & + tempPerSlip(1:Nchunks_SlipFamilies) + case ('friction_coeff') + plastic_disloUCLA_friction(1:Nchunks_SlipFamilies,instance) = & + tempPerSlip(1:Nchunks_SlipFamilies) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on slip number of twin families + case ('ntwin') + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_TwinFamilies + plastic_disloUCLA_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('ndot0','twinsize','twinburgers','r_twin') + do j = 1_pInt, Nchunks_TwinFamilies + tempPerTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('ndot0') + if (lattice_structure(phase) == LATTICE_fcc_ID) & + call IO_warning(42_pInt,ext_msg=trim(tag)//' for fcc ('//PLASTICITY_DISLOUCLA_label//')') + plastic_disloUCLA_Ndot0PerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + case ('twinsize') + plastic_disloUCLA_twinsizePerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + case ('twinburgers') + plastic_disloUCLA_burgersPerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + case ('r_twin') + plastic_disloUCLA_rPerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of interactions + case ('interaction_slipslip','interactionslipslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + do j = 1_pInt, Nchunks_SlipSlip + plastic_disloUCLA_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_sliptwin','interactionsliptwin') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + do j = 1_pInt, Nchunks_SlipTwin + plastic_disloUCLA_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twinslip','interactiontwinslip') + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + do j = 1_pInt, Nchunks_TwinSlip + plastic_disloUCLA_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twintwin','interactiontwintwin') + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + do j = 1_pInt, Nchunks_TwinTwin + plastic_disloUCLA_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('nonschmid_coefficients') + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') + do j = 1_pInt,Nchunks_nonSchmid + plastic_disloUCLA_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters independent of number of slip/twin systems + case ('grainsize') + plastic_disloUCLA_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('maxtwinfraction') + plastic_disloUCLA_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('d0') + plastic_disloUCLA_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('qsd') + plastic_disloUCLA_Qsd(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_rho') + plastic_disloUCLA_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_twinfrac') + plastic_disloUCLA_aTolTwinFrac(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cmfptwin') + plastic_disloUCLA_Cmfptwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cthresholdtwin') + plastic_disloUCLA_Cthresholdtwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('solidsolutionstrength') + plastic_disloUCLA_SolidSolutionStrength(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('l0') + plastic_disloUCLA_L0(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('xc') + plastic_disloUCLA_xc(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('vcrossslip') + plastic_disloUCLA_VcrossSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cedgedipmindistance') + plastic_disloUCLA_CEdgeDipMinDistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('catomicvolume') + plastic_disloUCLA_CAtomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('sfe_0k') + plastic_disloUCLA_SFE_0K(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('dsfe_dt') + plastic_disloUCLA_dSFE_dT(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('dipoleformationfactor') + plastic_disloUCLA_dipoleFormationFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) + end select + endif; endif + enddo parsingFile + + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_disloUCLA_ID) then + instance = phase_plasticityInstance(phase) + if (sum(plastic_disloUCLA_Nslip(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='Nslip ('//PLASTICITY_DISLOUCLA_label//')') + if (sum(plastic_disloUCLA_Ntwin(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='Ntwin ('//PLASTICITY_DISLOUCLA_label//')') + do f = 1_pInt,lattice_maxNslipFamily + if (plastic_disloUCLA_Nslip(f,instance) > 0_pInt) then + if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_v0PerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') + endif + enddo + do f = 1_pInt,lattice_maxNtwinFamily + if (plastic_disloUCLA_Ntwin(f,instance) > 0_pInt) then + if (plastic_disloUCLA_burgersPerTwinFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_Ndot0PerTwinFamily(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='ndot0 ('//PLASTICITY_DISLOUCLA_label//')') + endif + enddo + if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_D0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') + if (sum(plastic_disloUCLA_Ntwin(:,instance)) > 0_pInt) then + if (abs(plastic_disloUCLA_SFE_0K(instance)) <= tiny(0.0_pReal) .and. & + abs(plastic_disloUCLA_dSFE_dT(instance)) <= tiny(0.0_pReal) .and. & + lattice_structure(phase) == LATTICE_fcc_ID) & + call IO_error(211_pInt,el=instance,ext_msg='SFE0K ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_aTolTwinFrac(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTwinFrac ('//PLASTICITY_DISLOUCLA_label//')') + endif + if (abs(plastic_disloUCLA_dipoleFormationFactor(instance)) > tiny(0.0_pReal) .and. & + plastic_disloUCLA_dipoleFormationFactor(instance) /= 1.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='dipoleFormationFactor ('//PLASTICITY_DISLOUCLA_label//')') + +!-------------------------------------------------------------------------------------------------- +! Determine total number of active slip or twin systems + plastic_disloUCLA_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_disloUCLA_Nslip(:,instance)) + plastic_disloUCLA_Ntwin(:,instance) = min(lattice_NtwinSystem(:,phase),plastic_disloUCLA_Ntwin(:,instance)) + plastic_disloUCLA_totalNslip(instance) = sum(plastic_disloUCLA_Nslip(:,instance)) + plastic_disloUCLA_totalNtwin(instance) = sum(plastic_disloUCLA_Ntwin(:,instance)) + endif myPhase + enddo sanityChecks + +!-------------------------------------------------------------------------------------------------- +! allocation of variables whose size depends on the total number of active slip systems + maxTotalNslip = maxval(plastic_disloUCLA_totalNslip) + maxTotalNtwin = maxval(plastic_disloUCLA_totalNtwin) + + allocate(plastic_disloUCLA_burgersPerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_burgersPerTwinSystem(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_QedgePerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_v0PerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_Ndot0PerTwinSystem(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_tau_r(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_twinsizePerTwinSystem(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_CLambdaSlipPerSlipSystem(maxTotalNslip, maxNinstance),source=0.0_pReal) + + allocate(plastic_disloUCLA_interactionMatrix_SlipSlip(maxval(plastic_disloUCLA_totalNslip),& ! slip resistance from slip activity + maxval(plastic_disloUCLA_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_interactionMatrix_SlipTwin(maxval(plastic_disloUCLA_totalNslip),& ! slip resistance from twin activity + maxval(plastic_disloUCLA_totalNtwin),& + maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_interactionMatrix_TwinSlip(maxval(plastic_disloUCLA_totalNtwin),& ! twin resistance from slip activity + maxval(plastic_disloUCLA_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_interactionMatrix_TwinTwin(maxval(plastic_disloUCLA_totalNtwin),& ! twin resistance from twin activity + maxval(plastic_disloUCLA_totalNtwin),& + maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), & + source=0.0_pReal) + allocate(plastic_disloUCLA_Ctwin66(6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_Ctwin3333(3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) + + allocate(state(maxNinstance)) + allocate(state0(maxNinstance)) + allocate(dotState(maxNinstance)) + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + myPhase2: if (phase_plasticity(phase) == PLASTICITY_disloUCLA_ID) then + NofMyPhase=count(material_phase==phase) + instance = phase_plasticityInstance(phase) + + ns = plastic_disloUCLA_totalNslip(instance) + nt = plastic_disloUCLA_totalNtwin(instance) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputs: do o = 1_pInt,plastic_disloUCLA_Noutput(instance) + select case(plastic_disloUCLA_outputID(o,instance)) + case(edge_density_ID, & + dipole_density_ID, & + shear_rate_slip_ID, & + accumulated_shear_slip_ID, & + mfp_slip_ID, & + resolved_stress_slip_ID, & + threshold_stress_slip_ID, & + edge_dipole_distance_ID, & + stress_exponent_ID & + ) + mySize = ns + case(twin_fraction_ID, & + shear_rate_twin_ID, & + accumulated_shear_twin_ID, & + mfp_twin_ID, & + resolved_stress_twin_ID, & + threshold_stress_twin_ID & + ) + mySize = nt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + plastic_disloUCLA_sizePostResult(o,instance) = mySize + plastic_disloUCLA_sizePostResults(instance) = plastic_disloUCLA_sizePostResults(instance) + mySize + endif + enddo outputs + +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + + sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * ns & + + int(size(['twinFraction','accsheartwin']),pInt) * nt + sizeDeltaState = 0_pInt + sizeState = sizeDotState & + + int(size(['invLambdaSlip ','invLambdaSlipTwin ',& + 'meanFreePathSlip ','tauSlipThreshold ']),pInt) * ns & + + int(size(['invLambdaTwin ','meanFreePathTwin','tauTwinThreshold',& + 'twinVolume ']),pInt) * nt + + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_disloUCLA_sizePostResults(instance) + plasticState(phase)%nSlip = plastic_disloucla_totalNslip(instance) + plasticState(phase)%nTwin = plastic_disloucla_totalNtwin(instance) + plasticState(phase)%nTrans= 0_pInt + allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + offset_slip = 2_pInt*plasticState(phase)%nSlip + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) + !* Process slip related parameters ------------------------------------------------ + + mySlipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list + mySlipSystems: do j = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + + !* Burgers vector, + ! dislocation velocity prefactor, + ! mean free path prefactor, + ! and minimum dipole distance + + plastic_disloUCLA_burgersPerSlipSystem(index_myFamily+j,instance) = & + plastic_disloUCLA_burgersPerSlipFamily(f,instance) + + plastic_disloUCLA_QedgePerSlipSystem(index_myFamily+j,instance) = & + plastic_disloUCLA_QedgePerSlipFamily(f,instance) + + plastic_disloUCLA_v0PerSlipSystem(index_myFamily+j,instance) = & + plastic_disloUCLA_v0PerSlipFamily(f,instance) + + plastic_disloUCLA_CLambdaSlipPerSlipSystem(index_myFamily+j,instance) = & + plastic_disloUCLA_CLambdaSlipPerSlipFamily(f,instance) + + !* Calculation of forest projections for edge dislocations + !* Interaction matrices + + otherSlipFamilies: do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_disloUCLA_Nslip(1:o-1_pInt,instance)) + otherSlipSystems: do k = 1_pInt,plastic_disloUCLA_Nslip(o,instance) + plastic_disloUCLA_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,instance) = & + abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,phase))+j,phase), & + lattice_st(:,sum(lattice_NslipSystem(1:o-1,phase))+k,phase))) + plastic_disloUCLA_interactionMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_disloUCLA_interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase), instance ) + enddo otherSlipSystems; enddo otherSlipFamilies + + otherTwinFamilies: do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_disloUCLA_Ntwin(1:o-1_pInt,instance)) + otherTwinSystems: do k = 1_pInt,plastic_disloUCLA_Ntwin(o,instance) + plastic_disloUCLA_interactionMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_disloUCLA_interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo otherTwinSystems; enddo otherTwinFamilies + + enddo mySlipSystems + enddo mySlipFamilies + + !* Process twin related parameters ------------------------------------------------ + + myTwinFamilies: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(plastic_disloUCLA_Ntwin(1:f-1_pInt,instance)) ! index in truncated twin system list + myTwinSystems: do j = 1_pInt,plastic_disloUCLA_Ntwin(f,instance) + + !* Burgers vector, + ! nucleation rate prefactor, + ! and twin size + + plastic_disloUCLA_burgersPerTwinSystem(index_myFamily+j,instance) = & + plastic_disloUCLA_burgersPerTwinFamily(f,instance) + + plastic_disloUCLA_Ndot0PerTwinSystem(index_myFamily+j,instance) = & + plastic_disloUCLA_Ndot0PerTwinFamily(f,instance) + + plastic_disloUCLA_twinsizePerTwinSystem(index_myFamily+j,instance) = & + plastic_disloUCLA_twinsizePerTwinFamily(f,instance) + + !* Rotate twin elasticity matrices + index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! 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 + plastic_disloUCLA_Ctwin3333(l,m,n,o,index_myFamily+j,instance) = & + plastic_disloUCLA_Ctwin3333(l,m,n,o,index_myFamily+j,instance) + & + lattice_C3333(p,q,r,s,instance) * & + lattice_Qtwin(l,p,index_otherFamily+j,phase) * & + lattice_Qtwin(m,q,index_otherFamily+j,phase) * & + lattice_Qtwin(n,r,index_otherFamily+j,phase) * & + lattice_Qtwin(o,s,index_otherFamily+j,phase) + enddo; enddo; enddo; enddo + enddo; enddo; enddo; enddo + plastic_disloUCLA_Ctwin66(1:6,1:6,index_myFamily+j,instance) = & + math_Mandel3333to66(plastic_disloUCLA_Ctwin3333(1:3,1:3,1:3,1:3,index_myFamily+j,instance)) + + !* Interaction matrices + otherSlipFamilies2: do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_disloUCLA_Nslip(1:o-1_pInt,instance)) + otherSlipSystems2: do k = 1_pInt,plastic_disloUCLA_Nslip(o,instance) + plastic_disloUCLA_interactionMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_disloUCLA_interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo otherSlipSystems2; enddo otherSlipFamilies2 + + otherTwinFamilies2: do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_disloUCLA_Ntwin(1:o-1_pInt,instance)) + otherTwinSystems2: do k = 1_pInt,plastic_disloUCLA_Ntwin(o,instance) + plastic_disloUCLA_interactionMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_disloUCLA_interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo otherTwinSystems2; enddo otherTwinFamilies2 + + enddo myTwinSystems + enddo myTwinFamilies + + startIndex=1_pInt + endIndex=ns + state(instance)%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%rhoEdge=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1_pInt + endIndex=endIndex+ns + state(instance)%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%rhoEdgeDip=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1_pInt + endIndex=endIndex+ns + state(instance)%accshear_slip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%accshear_slip=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1_pInt + endIndex=endIndex+nt + state(instance)%twinFraction=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%twinFraction=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%twinFraction=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1_pInt + endIndex=endIndex+nt + state(instance)%accshear_twin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%accshear_twin=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1_pInt + endIndex=endIndex+ns + state(instance)%invLambdaSlip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaSlip=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%invLambdaSlipTwin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaSlipTwin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%invLambdaTwin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaTwin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%mfp_slip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%mfp_slip=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%mfp_twin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%mfp_twin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%threshold_stress_slip=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%threshold_stress_twin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%threshold_stress_twin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%twinVolume=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%twinVolume=>plasticState(phase)%state0(startIndex:endIndex,:) + + call plastic_disloUCLA_stateInit(phase,instance) + call plastic_disloUCLA_aTolState(phase,instance) + endif myPhase2 + + enddo initializeInstances + +end subroutine plastic_disloUCLA_init + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the relevant state values for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_stateInit(ph,instance) + use math, only: & + pi + use lattice, only: & + lattice_maxNslipFamily, & + lattice_mu + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + + real(pReal), dimension(plasticState(ph)%sizeState) :: tempState + + integer(pInt) :: i,j,f,ns,nt, index_myFamily + real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & + rhoEdge0, & + rhoEdgeDip0, & + invLambdaSlip0, & + MeanFreePathSlip0, & + tauSlipThreshold0 + real(pReal), dimension(plastic_disloUCLA_totalNtwin(instance)) :: & + MeanFreePathTwin0,TwinVolume0 + tempState = 0.0_pReal + ns = plastic_disloUCLA_totalNslip(instance) + nt = plastic_disloUCLA_totalNtwin(instance) + +!-------------------------------------------------------------------------------------------------- +! initialize basic slip state variables + do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list + rhoEdge0(index_myFamily+1_pInt: & + index_myFamily+plastic_disloUCLA_Nslip(f,instance)) = & + plastic_disloUCLA_rhoEdge0(f,instance) + rhoEdgeDip0(index_myFamily+1_pInt: & + index_myFamily+plastic_disloUCLA_Nslip(f,instance)) = & + plastic_disloUCLA_rhoEdgeDip0(f,instance) + enddo + + tempState(1_pInt:ns) = rhoEdge0 + tempState(ns+1_pInt:2_pInt*ns) = rhoEdgeDip0 + +!-------------------------------------------------------------------------------------------------- +! initialize dependent slip microstructural variables + forall (i = 1_pInt:ns) & + invLambdaSlip0(i) = sqrt(dot_product((rhoEdge0+rhoEdgeDip0),plastic_disloUCLA_forestProjectionEdge(1:ns,i,instance)))/ & + plastic_disloUCLA_CLambdaSlipPerSlipSystem(i,instance) + tempState(3_pInt*ns+2_pInt*nt+1:4_pInt*ns+2_pInt*nt) = invLambdaSlip0 + + forall (i = 1_pInt:ns) & + MeanFreePathSlip0(i) = & + plastic_disloUCLA_GrainSize(instance)/(1.0_pReal+invLambdaSlip0(i)*plastic_disloUCLA_GrainSize(instance)) + tempState(5_pInt*ns+3_pInt*nt+1:6_pInt*ns+3_pInt*nt) = MeanFreePathSlip0 + + forall (i = 1_pInt:ns) & + tauSlipThreshold0(i) = & + lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(i,instance) * & + sqrt(dot_product((rhoEdge0+rhoEdgeDip0),plastic_disloUCLA_interactionMatrix_SlipSlip(i,1:ns,instance))) + + tempState(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) = plastic_disloUCLA_GrainSize(instance) + tempState(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)*plastic_disloUCLA_twinsizePerTwinSystem(j,instance)*MeanFreePathTwin0(j)**(2.0_pReal) + tempState(7_pInt*ns+5_pInt*nt+1_pInt:7_pInt*ns+6_pInt*nt) = TwinVolume0 + +plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) + +end subroutine plastic_disloUCLA_stateInit + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the relevant state values for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_aTolState(ph,instance) + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + ph, & + instance ! number specifying the current instance of the plasticity + + ! Tolerance state for dislocation densities + plasticState(ph)%aTolState(1_pInt:2_pInt*plastic_disloUCLA_totalNslip(instance)) = & + plastic_disloUCLA_aTolRho(instance) + + ! Tolerance state for accumulated shear due to slip + plasticState(ph)%aTolState(2_pInt*plastic_disloUCLA_totalNslip(instance)+1_pInt: & + 3_pInt*plastic_disloUCLA_totalNslip(instance))=1e6_pReal + + + ! Tolerance state for twin volume fraction + plasticState(ph)%aTolState(3_pInt*plastic_disloUCLA_totalNslip(instance)+1_pInt: & + 3_pInt*plastic_disloUCLA_totalNslip(instance)+& + plastic_disloUCLA_totalNtwin(instance)) = & + plastic_disloUCLA_aTolTwinFrac(instance) + +! Tolerance state for accumulated shear due to twin + plasticState(ph)%aTolState(3_pInt*plastic_disloUCLA_totalNslip(instance)+ & + plastic_disloUCLA_totalNtwin(instance)+1_pInt: & + 3_pInt*plastic_disloUCLA_totalNslip(instance)+ & + 2_pInt*plastic_disloUCLA_totalNtwin(instance)) = 1e6_pReal + +end subroutine plastic_disloUCLA_aTolState + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns the homogenized elasticity matrix +!-------------------------------------------------------------------------------------------------- +function plastic_disloUCLA_homogenizedC(ipc,ip,el) + use material, only: & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_C66 + + implicit none + real(pReal), dimension(6,6) :: & + plastic_disloUCLA_homogenizedC + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + + integer(pInt) :: instance,ns,nt,i, & + ph, & + of + real(pReal) :: sumf + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_disloUCLA_totalNslip(instance) + nt = plastic_disloUCLA_totalNtwin(instance) + + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + !* Homogenized elasticity matrix + plastic_disloUCLA_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,ph) + do i=1_pInt,nt + plastic_disloUCLA_homogenizedC = plastic_disloUCLA_homogenizedC & + + state(instance)%twinFraction(i,of)*plastic_disloUCLA_Ctwin66(1:6,1:6,i,instance) + enddo + +end function plastic_disloUCLA_homogenizedC + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) + use math, only: & + pi + use material, only: & + material_phase, & + phase_plasticityInstance, & + phaseAt, phasememberAt + use lattice, only: & + lattice_mu, & + lattice_nu + + 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 + + integer(pInt) :: & + instance, & + ns,nt,s,t, & + ph, & + of + real(pReal) :: & + sumf,sfe,x0 + real(pReal), dimension(plastic_disloUCLA_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: fOverStacksize + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_disloUCLA_totalNslip(instance) + nt = plastic_disloUCLA_totalNtwin(instance) + + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + + !* Stacking fault energy + sfe = plastic_disloUCLA_SFE_0K(instance) + & + plastic_disloUCLA_dSFE_dT(instance) * Temperature + + !* rescaled twin volume fraction for topology + forall (t = 1_pInt:nt) & + fOverStacksize(t) = & + state(instance)%twinFraction(t,of)/plastic_disloUCLA_twinsizePerTwinSystem(t,instance) + + !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation + forall (s = 1_pInt:ns) & + state(instance)%invLambdaSlip(s,of) = & + sqrt(dot_product((state(instance)%rhoEdge(1_pInt:ns,of)+state(instance)%rhoEdgeDip(1_pInt:ns,of)),& + plastic_disloUCLA_forestProjectionEdge(1:ns,s,instance)))/ & + plastic_disloUCLA_CLambdaSlipPerSlipSystem(s,instance) + !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation + !$OMP CRITICAL (evilmatmul) + state(instance)%invLambdaSlipTwin(1_pInt:ns,of) = 0.0_pReal + if (nt > 0_pInt .and. ns > 0_pInt) & + state(instance)%invLambdaSlipTwin(1_pInt:ns,of) = & + matmul(plastic_disloUCLA_interactionMatrix_SlipTwin(1:ns,1:nt,instance),fOverStacksize(1:nt))/(1.0_pReal-sumf) + !$OMP END CRITICAL (evilmatmul) + + !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + !$OMP CRITICAL (evilmatmul) + if (nt > 0_pInt) & + state(instance)%invLambdaTwin(1_pInt:nt,of) = & + matmul(plastic_disloUCLA_interactionMatrix_TwinTwin(1:nt,1:nt,instance),fOverStacksize(1:nt))/(1.0_pReal-sumf) + !$OMP END CRITICAL (evilmatmul) + + !* mean free path between 2 obstacles seen by a moving dislocation + do s = 1_pInt,ns + if (nt > 0_pInt) then + state(instance)%mfp_slip(s,of) = & + plastic_disloUCLA_GrainSize(instance)/(1.0_pReal+plastic_disloUCLA_GrainSize(instance)*& + (state(instance)%invLambdaSlip(s,of)+state(instance)%invLambdaSlipTwin(s,of))) + else + state(instance)%mfp_slip(s,of) = & + plastic_disloUCLA_GrainSize(instance)/& + (1.0_pReal+plastic_disloUCLA_GrainSize(instance)*(state(instance)%invLambdaSlip(s,of))) + endif + enddo + + !* mean free path between 2 obstacles seen by a growing twin + forall (t = 1_pInt:nt) & + state(instance)%mfp_twin(t,of) = & + (plastic_disloUCLA_Cmfptwin(instance)*plastic_disloUCLA_GrainSize(instance))/& + (1.0_pReal+plastic_disloUCLA_GrainSize(instance)*state(instance)%invLambdaTwin(t,of)) + + !* threshold stress for dislocation motion + forall (s = 1_pInt:ns) & + state(instance)%threshold_stress_slip(s,of) = & + lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(s,instance)*& + sqrt(dot_product((state(instance)%rhoEdge(1_pInt:ns,of)+state(instance)%rhoEdgeDip(1_pInt:ns,of)),& + plastic_disloUCLA_interactionMatrix_SlipSlip(s,1:ns,instance))) + + !* threshold stress for growing twin + forall (t = 1_pInt:nt) & + state(instance)%threshold_stress_twin(t,of) = & + plastic_disloUCLA_Cthresholdtwin(instance)*& + (sfe/(3.0_pReal*plastic_disloUCLA_burgersPerTwinSystem(t,instance))+& + 3.0_pReal*plastic_disloUCLA_burgersPerTwinSystem(t,instance)*lattice_mu(ph)/& + (plastic_disloUCLA_L0(instance)*plastic_disloUCLA_burgersPerSlipSystem(t,instance))) + + !* final twin volume after growth + forall (t = 1_pInt:nt) & + state(instance)%twinVolume(t,of) = & + (pi/4.0_pReal)*plastic_disloUCLA_twinsizePerTwinSystem(t,instance)*state(instance)%mfp_twin(t,of)**(2.0_pReal) + + !* equilibrium seperation of partial dislocations + do t = 1_pInt,nt + x0 = lattice_mu(ph)*plastic_disloUCLA_burgersPerTwinSystem(t,instance)**(2.0_pReal)/& + (sfe*8.0_pReal*pi)*(2.0_pReal+lattice_nu(ph))/(1.0_pReal-lattice_nu(ph)) + plastic_disloUCLA_tau_r(t,instance)= & + lattice_mu(ph)*plastic_disloUCLA_burgersPerTwinSystem(t,instance)/(2.0_pReal*pi)*& + (1/(x0+plastic_disloUCLA_xc(instance))+cos(pi/3.0_pReal)/x0) !!! used where?? + enddo + +end subroutine plastic_disloUCLA_microstructure + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature,ipc,ip,el) + use prec, only: & + tol_math_check + use math, only: & + math_Plain3333to99, & + math_Mandel6to33, & + math_Mandel33to6, & + math_spectralDecompositionSym33, & + math_symmetric33, & + math_mul33x3 + use material, only: & + material_phase, & + phase_plasticityInstance, & + !plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_Sslip, & + lattice_Sslip_v, & + lattice_Stwin, & + lattice_Stwin_v, & + lattice_maxNslipFamily,& + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NnonSchmid, & + lattice_shearTwin, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & + LATTICE_fcc_ID + + implicit none + integer(pInt), intent(in) :: ipc,ip,el + real(pReal), intent(in) :: Temperature + real(pReal), dimension(6), intent(in) :: Tstar_v + real(pReal), dimension(3,3), intent(out) :: Lp + real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 + + integer(pInt) :: instance,ph,of,ns,nt,f,i,j,k,l,m,n,index_myFamily,s1,s2 + real(pReal) :: sumf,StressRatio_p,StressRatio_pminus1,StressRatio_r,BoltzmannRatio,DotGamma0,Ndot0, & + tau_slip_pos,tau_slip_neg,vel_slip,dvel_slip,& + dgdot_dtauslip_pos,dgdot_dtauslip_neg,dgdot_dtautwin,tau_twin,gdot_twin,stressRatio + real(pReal), dimension(3,3,2) :: & + nonSchmid_tensor + real(pReal), dimension(3,3,3,3) :: & + dLp_dTstar3333 + real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip_pos,gdot_slip_neg + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_disloUCLA_totalNslip(instance) + nt = plastic_disloUCLA_totalNtwin(instance) + + Lp = 0.0_pReal + dLp_dTstar3333 = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! Dislocation glide part + gdot_slip_pos = 0.0_pReal + gdot_slip_neg = 0.0_pReal + dgdot_dtauslip_pos = 0.0_pReal + dgdot_dtauslip_neg = 0.0_pReal + + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + j = j+1_pInt + !* Boltzmann ratio + BoltzmannRatio = plastic_disloUCLA_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& + plastic_disloUCLA_v0PerSlipSystem(j,instance) + !* Resolved shear stress on slip system + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) + nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_disloUCLA_nonSchmidCoeff(k,instance)*& + lattice_Sslip(1:3,1:3,2*k, index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_disloUCLA_nonSchmidCoeff(k,instance)*& + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + enddo nonSchmidSystems + + significantPostitiveStress: if((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratio + stressRatio = ((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+& + plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) + stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) + !* Shear rates due to slip + vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * (tau_slip_pos & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + / ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) + + gdot_slip_pos(j) = DotGamma0 & + * vel_slip & + * sign(1.0_pReal,tau_slip_pos) + + !* Derivatives of shear rates + dvel_slip = & + 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * ( & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + + tau_slip_pos & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) + ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) & + - (tau_slip_pos & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) + ) & + ) & + / ( & + ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + )**2.0_pReal & + ) + dgdot_dtauslip_pos = DotGamma0 * dvel_slip + + endif significantPostitiveStress + significantNegativeStress: if((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratio + stressRatio = ((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+& + plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) + stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) + !* Shear rates due to slip + vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * (tau_slip_neg & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + / ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) + + gdot_slip_neg(j) = DotGamma0 & + * vel_slip & + * sign(1.0_pReal,tau_slip_neg) + + !* Derivatives of shear rates + dvel_slip = & + 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * ( & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + + tau_slip_neg & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) + ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) & + - (tau_slip_neg & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) + ) & + ) & + / ( & + ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + )**2.0_pReal & + ) + + dgdot_dtauslip_neg = DotGamma0 * dvel_slip + + endif significantNegativeStress + !* Plastic velocity gradient for dislocation glide + Lp = Lp + (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + !* Calculation of the tangent of Lp + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + (dgdot_dtauslip_pos*nonSchmid_tensor(m,n,1)+& + dgdot_dtauslip_neg*nonSchmid_tensor(m,n,2))*0.5_pReal*& + lattice_Sslip(k,l,1,index_myFamily+i,ph) + enddo slipSystems + enddo slipFamilies + +!-------------------------------------------------------------------------------------------------- +! correct Lp and dLp_dTstar3333 for twinned fraction + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + Lp = Lp * (1.0_pReal - sumf) + dLp_dTstar3333 = dLp_dTstar3333 * (1.0_pReal - sumf) + +!-------------------------------------------------------------------------------------------------- +! Mechanical twinning part + gdot_twin = 0.0_pReal + dgdot_dtautwin = 0.0_pReal + j = 0_pInt + twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems: do i = 1_pInt,plastic_disloUCLA_Ntwin(f,instance) + j = j+1_pInt + !* Resolved shear stress on twin system + tau_twin = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + + !* Stress ratios + if (tau_twin > tol_math_check) then + StressRatio_r = (state(instance)%threshold_stress_twin(j,of)/tau_twin)**plastic_disloUCLA_rPerTwinFamily(f,instance) + !* Shear rates and their derivatives due to twin + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_twin < plastic_disloUCLA_tau_r(j,instance)) then + Ndot0=(abs(gdot_slip_pos(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& !no non-Schmid behavior for fcc, just take the not influenced positive gdot_slip_pos (= gdot_slip_neg) + abs(gdot_slip_pos(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_disloUCLA_L0(instance)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_disloUCLA_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_disloUCLA_tau_r(j,instance)-tau_twin))) + else + Ndot0=0.0_pReal + end if + case default + Ndot0=plastic_disloUCLA_Ndot0PerTwinSystem(j,instance) + end select + gdot_twin = & + (plastic_disloUCLA_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& + state(instance)%twinVolume(j,of)*Ndot0*exp(-StressRatio_r) + dgdot_dtautwin = ((gdot_twin*plastic_disloUCLA_rPerTwinFamily(f,instance))/tau_twin)*StressRatio_r + endif + + !* Plastic velocity gradient for mechanical twinning + Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) + + !* Calculation of the tangent of Lp + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin*& + lattice_Stwin(k,l,index_myFamily+i,ph)*& + lattice_Stwin(m,n,index_myFamily+i,ph) + enddo twinSystems + enddo twinFamilies + + dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) + +end subroutine plastic_disloUCLA_LpAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) + use prec, only: & + tol_math_check + use math, only: & + pi + use material, only: & + material_phase, & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NnonSchmid, & + lattice_sheartwin, & + lattice_mu, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & + LATTICE_fcc_ID + + 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 + + integer(pInt) :: instance,ns,nt,f,i,j,k,index_myFamily,s1,s2, & + ph, & + of + real(pReal) :: & + sumf, & + stressRatio_p,& + BoltzmannRatio,& + DotGamma0,& + stressRatio, & + EdgeDipMinDistance,& + AtomicVolume,& + VacancyDiffusion,& + StressRatio_r,& + Ndot0,& + tau_slip_pos,& + tau_slip_neg,& + DotRhoMultiplication,& + EdgeDipDistance, & + DotRhoEdgeDipAnnihilation, & + DotRhoEdgeEdgeAnnihilation, & + ClimbVelocity, & + DotRhoEdgeDipClimb, & + DotRhoDipFormation, & + tau_twin, & + vel_slip, & + gdot_slip + real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip_pos, gdot_slip_neg + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_disloUCLA_totalNslip(instance) + nt = plastic_disloUCLA_totalNtwin(instance) + + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + plasticState(ph)%dotState(:,of) = 0.0_pReal + + !* Dislocation density evolution + gdot_slip_pos = 0.0_pReal + gdot_slip_neg = 0.0_pReal + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + j = j+1_pInt + !* Boltzmann ratio + BoltzmannRatio = plastic_disloUCLA_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& + plastic_disloUCLA_v0PerSlipSystem(j,instance) + !* Resolved shear stress on slip system + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + + nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + enddo nonSchmidSystems + + significantPositiveStress: if((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratios + stressRatio = ((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+& + plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) + !* Shear rates due to slip + vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * (tau_slip_pos & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + / ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) + + gdot_slip_pos(j) = DotGamma0 & + * vel_slip & + * sign(1.0_pReal,tau_slip_pos) + endif significantPositiveStress + significantNegativeStress: if((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratios + stressRatio = ((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+& + plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) + + vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * (tau_slip_neg & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + / ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) + + gdot_slip_neg(j) = DotGamma0 & + * vel_slip & + * sign(1.0_pReal,tau_slip_neg) + endif significantNegativeStress + gdot_slip = (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal + !* Multiplication + DotRhoMultiplication = abs(gdot_slip)/& + (plastic_disloUCLA_burgersPerSlipSystem(j,instance)* & + state(instance)%mfp_slip(j,of)) + + !* Dipole formation + EdgeDipMinDistance = & + plastic_disloUCLA_CEdgeDipMinDistance(instance)*plastic_disloUCLA_burgersPerSlipSystem(j,instance) + if (abs(tau_slip_pos) <= tiny(0.0_pReal)) then + DotRhoDipFormation = 0.0_pReal + else + EdgeDipDistance = & + (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& + (16.0_pReal*pi*abs(tau_slip_pos)) + if (EdgeDipDistance>state(instance)%mfp_slip(j,of)) EdgeDipDistance=state(instance)%mfp_slip(j,of) + if (EdgeDipDistance tol_math_check) then + StressRatio_r = (state(instance)%threshold_stress_twin(j,of)/tau_twin)**plastic_disloUCLA_rPerTwinFamily(f,instance) + !* Shear rates and their derivatives due to twin + + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_twin < plastic_disloUCLA_tau_r(j,instance)) then + Ndot0=(abs(gdot_slip_pos(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& !no non-Schmid behavior for fcc, just take the not influenced positive slip (gdot_slip_pos = gdot_slip_neg) + abs(gdot_slip_pos(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_disloUCLA_L0(instance)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_disloUCLA_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_disloUCLA_tau_r(j,instance)-tau_twin))) + else + Ndot0=0.0_pReal + end if + case default + Ndot0=plastic_disloUCLA_Ndot0PerTwinSystem(j,instance) + end select + + dotState(instance)%twinFraction(j, of) = & + (plastic_disloUCLA_MaxTwinFraction(instance)-sumf)*& + state(instance)%twinVolume(j, of)*Ndot0*exp(-StressRatio_r) + !* Dotstate for accumulated shear due to twin + dotState(instance)%accshear_twin(j,of) = dotState(ph)%twinFraction(j,of) * & + lattice_sheartwin(index_myfamily+i,ph) + endif + enddo twinSystems + enddo twinFamilies + +end subroutine plastic_disloUCLA_dotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) + use prec, only: & + tol_math_check + use math, only: & + pi + use material, only: & + material_phase, & + phase_plasticityInstance,& + !plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NnonSchmid, & + lattice_shearTwin, & + lattice_mu, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & + LATTICE_fcc_ID + + 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 + + real(pReal), dimension(plastic_disloUCLA_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_disloUCLA_postResults + + integer(pInt) :: & + instance,& + ns,nt,& + f,o,i,c,j,k,index_myFamily,& + s1,s2, & + ph, & + of + real(pReal) :: sumf,tau_twin,StressRatio_p,StressRatio_pminus1,& + BoltzmannRatio,DotGamma0,StressRatio_r,Ndot0,stressRatio + real(pReal) :: dvel_slip, vel_slip + real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_disloUCLA_totalNslip(instance) + nt = plastic_disloUCLA_totalNtwin(instance) + + !* Total twin volume fraction + sumf = sum(state(ph)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + + !* Required output + c = 0_pInt + plastic_disloUCLA_postResults = 0.0_pReal + + do o = 1_pInt,plastic_disloUCLA_Noutput(instance) + select case(plastic_disloUCLA_outputID(o,instance)) + + case (edge_density_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdge(1_pInt:ns,of) + c = c + ns + case (dipole_density_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) + c = c + ns + case (shear_rate_slip_ID,shear_rate_twin_ID,stress_exponent_ID) + gdot_slip_pos = 0.0_pReal + gdot_slip_neg = 0.0_pReal + dgdot_dtauslip_pos = 0.0_pReal + dgdot_dtauslip_neg = 0.0_pReal + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + j = j + 1_pInt + !* Boltzmann ratio + BoltzmannRatio = plastic_disloUCLA_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& + plastic_disloUCLA_v0PerSlipSystem(j,instance) + !* Resolved shear stress on slip system + tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + tau_slip_neg(j) = tau_slip_pos(j) + + nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + enddo nonSchmidSystems + + significantPositiveTau: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j, of)) > tol_math_check) then + !* Stress ratio + stressRatio = ((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j, of))/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+& + plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) + stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) + !* Shear rates due to slip + vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * (tau_slip_pos(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + / ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) + + gdot_slip_pos(j) = DotGamma0 & + * vel_slip & + * sign(1.0_pReal,tau_slip_pos(j)) + !* Derivatives of shear rates + + dvel_slip = & + 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * ( & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + + tau_slip_pos(j) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) + ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) & + - (tau_slip_pos(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) + ) & + ) & + / ( & + ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + )**2.0_pReal & + ) + + dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip + + endif significantPositiveTau + significantNegativeTau: if((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j, of)) > tol_math_check) then + !* Stress ratios + stressRatio = ((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j, of))/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+& + plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) + stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) + !* Shear rates due to slip + vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * (tau_slip_neg(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + / ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) + + gdot_slip_neg(j) = DotGamma0 & + * vel_slip & + * sign(1.0_pReal,tau_slip_neg(j)) + !* Derivatives of shear rates + dvel_slip = & + 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & + * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & + * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + * ( & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + + tau_slip_neg(j) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) + ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + ) & + - (tau_slip_neg(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) + *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& + *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) + ) & + ) & + / ( & + ( & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & + + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + )**2.0_pReal & + ) + + + dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip + + endif significantNegativeTau + enddo slipSystems + enddo slipFamilies + + if (plastic_disloUCLA_outputID(o,instance) == shear_rate_slip_ID) then + plastic_disloUCLA_postResults(c+1:c+ns) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal + c = c + ns + elseif (plastic_disloUCLA_outputID(o,instance) == shear_rate_twin_ID) then + if (nt > 0_pInt) then + j = 0_pInt + twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems1: do i = 1,plastic_disloUCLA_Ntwin(f,instance) + j = j + 1_pInt + + !* Resolved shear stress on twin system + tau_twin = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + !* Stress ratios + StressRatio_r = (state(instance)%threshold_stress_twin(j, of)/ & + tau_twin)**plastic_disloUCLA_rPerTwinFamily(f,instance) + + !* Shear rates due to twin + if ( tau_twin > 0.0_pReal ) then + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_twin < plastic_disloUCLA_tau_r(j,instance)) then + Ndot0=(abs(gdot_slip_pos(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& !no non-Schmid behavior for fcc, just take the not influenced positive slip (gdot_slip_pos = gdot_slip_neg) + abs(gdot_slip_pos(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_disloUCLA_L0(instance)*& + plastic_disloUCLA_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_disloUCLA_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_disloUCLA_tau_r(j,instance)-tau_twin))) + else + Ndot0=0.0_pReal + end if + + case default + Ndot0=plastic_disloUCLA_Ndot0PerTwinSystem(j,instance) + end select + plastic_disloUCLA_postResults(c+j) = & + (plastic_disloUCLA_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& + state(instance)%twinVolume(j,of)*Ndot0*exp(-StressRatio_r) + endif + enddo twinSystems1 + enddo twinFamilies1 + endif + c = c + nt + elseif(plastic_disloUCLA_outputID(o,instance) == stress_exponent_ID) then + do j = 1_pInt, ns + if (abs(gdot_slip_pos(j)+gdot_slip_neg(j))<=tiny(0.0_pReal)) then + plastic_disloUCLA_postResults(c+j) = 0.0_pReal + else + plastic_disloUCLA_postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/& + (gdot_slip_pos(j)+gdot_slip_neg(j))*& + (dgdot_dtauslip_pos(j)+dgdot_dtauslip_neg(j))* 0.5_pReal + endif + enddo + c = c + ns + endif + + case (accumulated_shear_slip_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & + state(instance)%accshear_slip(1_pInt:ns, of) + c = c + ns + case (mfp_slip_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) =& + state(instance)%mfp_slip(1_pInt:ns, of) + c = c + ns + case (resolved_stress_slip_ID) + j = 0_pInt + slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems1: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + j = j + 1_pInt + plastic_disloUCLA_postResults(c+j) =& + dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + enddo slipSystems1; enddo slipFamilies1 + c = c + ns + case (threshold_stress_slip_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & + state(instance)%threshold_stress_slip(1_pInt:ns,of) + c = c + ns + case (edge_dipole_distance_ID) + j = 0_pInt + slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + j = j + 1_pInt + plastic_disloUCLA_postResults(c+j) = & + (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& + (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) + plastic_disloUCLA_postResults(c+j)=min(plastic_disloUCLA_postResults(c+j),& + state(instance)%mfp_slip(j,of)) + enddo slipSystems2; enddo slipFamilies2 + c = c + ns + case (twin_fraction_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+nt) = state(instance)%twinFraction(1_pInt:nt, of) + c = c + nt + + case (accumulated_shear_twin_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+nt) = state(instance)%accshear_twin(1_pInt:nt, of) + c = c + nt + + case (mfp_twin_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+nt) = state(instance)%mfp_twin(1_pInt:nt, of) + c = c + nt + + case (resolved_stress_twin_ID) + if (nt > 0_pInt) then + j = 0_pInt + twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems2: do i = 1_pInt,plastic_disloUCLA_Ntwin(f,instance) + j = j + 1_pInt + plastic_disloUCLA_postResults(c+j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + enddo twinSystems2; enddo twinFamilies2 + endif + c = c + nt + case (threshold_stress_twin_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+nt) = state(instance)%threshold_stress_twin(1_pInt:nt, of) + c = c + nt + end select + enddo +end function plastic_disloUCLA_postResults + +end module plastic_disloUCLA diff --git a/code/plastic/plastic_dislotwin.f90 b/code/plastic/plastic_dislotwin.f90 new file mode 100644 index 000000000..532312bfd --- /dev/null +++ b/code/plastic/plastic_dislotwin.f90 @@ -0,0 +1,2542 @@ +!-------------------------------------------------------------------------------------------------- +! $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 plastic_dislotwin + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_dislotwin_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_dislotwin_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_dislotwin_output !< name of each post result output + + real(pReal), parameter, private :: & + kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_dislotwin_Noutput !< number of outputs per instance of this plasticity + + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_dislotwin_totalNslip, & !< total number of active slip systems for each instance + plastic_dislotwin_totalNtwin, & !< total number of active twin systems for each instance + plastic_dislotwin_totalNtrans !< number of active transformation systems + + integer(pInt), dimension(:,:), allocatable, private :: & + plastic_dislotwin_Nslip, & !< number of active slip systems for each family and instance + plastic_dislotwin_Ntwin, & !< number of active twin systems for each family and instance + plastic_dislotwin_Ntrans !< number of active transformation systems for each family and instance + + real(pReal), dimension(:), allocatable, private :: & + plastic_dislotwin_CAtomicVolume, & !< atomic volume in Bugers vector unit + plastic_dislotwin_D0, & !< prefactor for self-diffusion coefficient + plastic_dislotwin_Qsd, & !< activation energy for dislocation climb + plastic_dislotwin_GrainSize, & !< grain size + plastic_dislotwin_pShearBand, & !< p-exponent in shearband velocity + plastic_dislotwin_qShearBand, & !< q-exponent in shearband velocity + plastic_dislotwin_MaxTwinFraction, & !< maximum allowed total twin volume fraction + plastic_dislotwin_CEdgeDipMinDistance, & !< + plastic_dislotwin_Cmfptwin, & !< + plastic_dislotwin_Cthresholdtwin, & !< + plastic_dislotwin_SolidSolutionStrength, & !< Strength due to elements in solid solution + plastic_dislotwin_L0_twin, & !< Length of twin nuclei in Burgers vectors + plastic_dislotwin_L0_trans, & !< Length of trans nuclei in Burgers vectors + plastic_dislotwin_xc_twin, & !< critical distance for formation of twin nucleus + plastic_dislotwin_xc_trans, & !< critical distance for formation of trans nucleus + plastic_dislotwin_VcrossSlip, & !< cross slip volume + plastic_dislotwin_sbResistance, & !< value for shearband resistance (might become an internal state variable at some point) + plastic_dislotwin_sbVelocity, & !< value for shearband velocity_0 + plastic_dislotwin_sbQedge, & !< value for shearband systems Qedge + plastic_dislotwin_SFE_0K, & !< stacking fault energy at zero K + plastic_dislotwin_dSFE_dT, & !< temperature dependance of stacking fault energy + plastic_dislotwin_dipoleFormationFactor, & !< scaling factor for dipole formation: 0: off, 1: on. other values not useful + plastic_dislotwin_aTolRho, & !< absolute tolerance for integration of dislocation density + plastic_dislotwin_aTolTwinFrac, & !< absolute tolerance for integration of twin volume fraction + plastic_dislotwin_aTolTransFrac, & !< absolute tolerance for integration of trans volume fraction + plastic_dislotwin_deltaG, & !< Free energy difference between austensite and martensite + plastic_dislotwin_Cmfptrans, & !< + plastic_dislotwin_Cthresholdtrans, & !< + plastic_dislotwin_transStackHeight !< Stack height of hex nucleus + + real(pReal), dimension(:,:,:,:), allocatable, private :: & + plastic_dislotwin_Ctwin66 !< twin elasticity matrix in Mandel notation for each instance + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & + plastic_dislotwin_Ctwin3333 !< twin elasticity matrix for each instance + real(pReal), dimension(:,:,:,:), allocatable, private :: & + plastic_dislotwin_Ctrans66 !< trans elasticity matrix in Mandel notation for each instance + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & + plastic_dislotwin_Ctrans3333 !< trans elasticity matrix for each instance + real(pReal), dimension(:,:), allocatable, private :: & + plastic_dislotwin_rhoEdge0, & !< initial edge dislocation density per slip system for each family and instance + plastic_dislotwin_rhoEdgeDip0, & !< initial edge dipole density per slip system for each family and instance + plastic_dislotwin_burgersPerSlipFamily, & !< absolute length of burgers vector [m] for each slip family and instance + plastic_dislotwin_burgersPerSlipSystem, & !< absolute length of burgers vector [m] for each slip system and instance + plastic_dislotwin_burgersPerTwinFamily, & !< absolute length of burgers vector [m] for each twin family and instance + plastic_dislotwin_burgersPerTwinSystem, & !< absolute length of burgers vector [m] for each twin system and instance + plastic_dislotwin_burgersPerTransFamily, & !< absolute length of burgers vector [m] for each trans family and instance + plastic_dislotwin_burgersPerTransSystem, & !< absolute length of burgers vector [m] for each trans system and instance + plastic_dislotwin_QedgePerSlipFamily, & !< activation energy for glide [J] for each slip family and instance + plastic_dislotwin_QedgePerSlipSystem, & !< activation energy for glide [J] for each slip system and instance + plastic_dislotwin_v0PerSlipFamily, & !< dislocation velocity prefactor [m/s] for each family and instance + plastic_dislotwin_v0PerSlipSystem, & !< dislocation velocity prefactor [m/s] for each slip system and instance + plastic_dislotwin_tau_peierlsPerSlipFamily, & !< Peierls stress [Pa] for each family and instance + plastic_dislotwin_Ndot0PerTwinFamily, & !< twin nucleation rate [1/m³s] for each twin family and instance + plastic_dislotwin_Ndot0PerTwinSystem, & !< twin nucleation rate [1/m³s] for each twin system and instance + plastic_dislotwin_Ndot0PerTransFamily, & !< trans nucleation rate [1/m³s] for each trans family and instance + plastic_dislotwin_Ndot0PerTransSystem, & !< trans nucleation rate [1/m³s] for each trans system and instance + plastic_dislotwin_tau_r_twin, & !< stress to bring partial close together for each twin system and instance + plastic_dislotwin_tau_r_trans, & !< stress to bring partial close together for each trans system and instance + plastic_dislotwin_twinsizePerTwinFamily, & !< twin thickness [m] for each twin family and instance + plastic_dislotwin_twinsizePerTwinSystem, & !< twin thickness [m] for each twin system and instance + plastic_dislotwin_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance + plastic_dislotwin_CLambdaSlipPerSlipSystem, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + plastic_dislotwin_lamellarsizePerTransFamily, & !< martensite lamellar thickness [m] for each trans family and instance + plastic_dislotwin_lamellarsizePerTransSystem, & !< martensite lamellar thickness [m] for each trans system and instance + plastic_dislotwin_interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance + plastic_dislotwin_interaction_SlipTwin, & !< coefficients for slip-twin interaction for each interaction type and instance + plastic_dislotwin_interaction_TwinSlip, & !< coefficients for twin-slip interaction for each interaction type and instance + plastic_dislotwin_interaction_TwinTwin, & !< coefficients for twin-twin interaction for each interaction type and instance + plastic_dislotwin_interaction_SlipTrans, & !< coefficients for slip-trans interaction for each interaction type and instance + plastic_dislotwin_interaction_TransSlip, & !< coefficients for trans-slip interaction for each interaction type and instance + plastic_dislotwin_interaction_TransTrans, & !< coefficients for trans-trans interaction for each interaction type and instance + plastic_dislotwin_pPerSlipFamily, & !< p-exponent in glide velocity + plastic_dislotwin_qPerSlipFamily, & !< q-exponent in glide velocity + plastic_dislotwin_rPerTwinFamily, & !< r-exponent in twin nucleation rate + plastic_dislotwin_sPerTransFamily !< s-exponent in trans nucleation rate + real(pReal), dimension(:,:,:), allocatable, private :: & + plastic_dislotwin_interactionMatrix_SlipSlip, & !< interaction matrix of the different slip systems for each instance + plastic_dislotwin_interactionMatrix_SlipTwin, & !< interaction matrix of slip systems with twin systems for each instance + plastic_dislotwin_interactionMatrix_TwinSlip, & !< interaction matrix of twin systems with slip systems for each instance + plastic_dislotwin_interactionMatrix_TwinTwin, & !< interaction matrix of the different twin systems for each instance + plastic_dislotwin_interactionMatrix_SlipTrans, & !< interaction matrix of slip systems with trans systems for each instance + plastic_dislotwin_interactionMatrix_TransSlip, & !< interaction matrix of trans systems with slip systems for each instance + plastic_dislotwin_interactionMatrix_TransTrans, & !< interaction matrix of the different trans systems for each instance + plastic_dislotwin_forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance + plastic_dislotwin_projectionMatrix_Trans !< matrix for projection of slip system shear on fault band (twin) systems for each instance + + real(pReal), dimension(:,:,:,:,:), allocatable, private :: & + plastic_dislotwin_sbSv + + enum, bind(c) + enumerator :: undefined_ID, & + edge_density_ID, & + dipole_density_ID, & + shear_rate_slip_ID, & + accumulated_shear_slip_ID, & + mfp_slip_ID, & + resolved_stress_slip_ID, & + threshold_stress_slip_ID, & + edge_dipole_distance_ID, & + stress_exponent_ID, & + twin_fraction_ID, & + shear_rate_twin_ID, & + accumulated_shear_twin_ID, & + mfp_twin_ID, & + resolved_stress_twin_ID, & + threshold_stress_twin_ID, & + resolved_stress_shearband_ID, & + shear_rate_shearband_ID, & + sb_eigenvalues_ID, & + sb_eigenvectors_ID, & + stress_trans_fraction_ID, & + strain_trans_fraction_ID, & + trans_fraction_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_dislotwin_outputID !< ID of each post result output + type, private :: tDislotwinState + real(pReal), pointer, dimension(:,:) :: & + rhoEdge, & + rhoEdgeDip, & + accshear_slip, & + twinFraction, & + accshear_twin, & + stressTransFraction, & + strainTransFraction , & + invLambdaSlip, & + invLambdaSlipTwin, & + invLambdaTwin, & + invLambdaSlipTrans, & + invLambdaTrans, & + mfp_slip, & + mfp_twin, & + mfp_trans, & + threshold_stress_slip, & + threshold_stress_twin, & + threshold_stress_trans, & + twinVolume, & + martensiteVolume + end type + type(tDislotwinState), allocatable, dimension(:), private :: & + state, & + state0, & + dotState + + public :: & + plastic_dislotwin_init, & + plastic_dislotwin_homogenizedC, & + plastic_dislotwin_microstructure, & + plastic_dislotwin_LpAndItsTangent, & + plastic_dislotwin_dotState, & + plastic_dislotwin_postResults + private :: & + plastic_dislotwin_stateInit, & + plastic_dislotwin_aTolState + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_init(fileUnit) + 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, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + homogenization_maxNgrains, & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_DISLOTWIN_label, & + PLASTICITY_DISLOTWIN_ID, & + material_phase, & + plasticState, & + MATERIAL_partPhase + use lattice + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,maxTotalNtwin,maxTotalNtrans,& + f,instance,j,k,l,m,n,o,p,q,r,s,ns,nt,nr, & + Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & + Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & + Nchunks_SlipTrans = 0_pInt, Nchunks_TransSlip = 0_pInt, Nchunks_TransTrans = 0_pInt, & + Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, Nchunks_TransFamilies = 0_pInt, & + offset_slip, index_myFamily, index_otherFamily, & + startIndex, endIndex + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + real(pReal), dimension(:), allocatable :: tempPerSlip, tempPerTwin, tempPerTrans + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_DISLOTWIN_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(plastic_dislotwin_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(plastic_dislotwin_output(maxval(phase_Noutput),maxNinstance)) + plastic_dislotwin_output = '' + allocate(plastic_dislotwin_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(plastic_dislotwin_Noutput(maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_Ntrans(lattice_maxNtransFamily,maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_totalNslip(maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_totalNtwin(maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_totalNtrans(maxNinstance), source=0_pInt) + allocate(plastic_dislotwin_CAtomicVolume(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_D0(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Qsd(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_GrainSize(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_pShearBand(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_qShearBand(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_MaxTwinFraction(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Cmfptwin(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Cthresholdtwin(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_SolidSolutionStrength(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_L0_twin(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_L0_trans(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_xc_twin(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_xc_trans(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_VcrossSlip(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_aTolRho(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_aTolTwinFrac(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_aTolTransFrac(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_sbResistance(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_sbVelocity(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_sbQedge(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_SFE_0K(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_dSFE_dT(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default + allocate(plastic_dislotwin_deltaG(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Cmfptrans(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Cthresholdtrans(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_transStackHeight(maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_rhoEdge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_rhoEdgeDip0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_burgersPerTwinFamily(lattice_maxNtwinFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_burgersPerTransFamily(lattice_maxNtransFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_QedgePerSlipFamily(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_tau_peierlsPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_pPerSlipFamily(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_dislotwin_qPerSlipFamily(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_dislotwin_Ndot0PerTwinFamily(lattice_maxNtwinFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_Ndot0PerTransFamily(lattice_maxNtransFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_twinsizePerTwinFamily(lattice_maxNtwinFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_rPerTwinFamily(lattice_maxNtwinFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_dislotwin_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_interaction_SlipTrans(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_interaction_TransSlip(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_interaction_TransTrans(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_sbSv(6,6,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) + allocate(plastic_dislotwin_lamellarsizePerTransFamily(lattice_maxNtransFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_sPerTransFamily(lattice_maxNtransFamily,maxNinstance),source=0.0_pReal) + + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_DISLOTWIN_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) + Nchunks_TransFamilies = count(lattice_NtransSystem(:,phase)> 0_pInt) + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + Nchunks_SlipTrans = maxval(lattice_interactionSlipTrans(:,:,phase)) + Nchunks_TransSlip = maxval(lattice_interactionTransSlip(:,:,phase)) + Nchunks_TransTrans = maxval(lattice_interactionTransTrans(:,:,phase)) + if(allocated(tempPerSlip)) deallocate(tempPerSlip) + if(allocated(tempPerTwin)) deallocate(tempPerTwin) + if(allocated(tempPerTrans)) deallocate(tempPerTrans) + allocate(tempPerSlip(Nchunks_SlipFamilies)) + allocate(tempPerTwin(Nchunks_TwinFamilies)) + allocate(tempPerTrans(Nchunks_TransFamilies)) + endif + cycle ! skip to next line + endif + + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOTWIN_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('edge_density') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = edge_density_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('dipole_density') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = dipole_density_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_rate_slip','shearrate_slip') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = shear_rate_slip_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulated_shear_slip') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = accumulated_shear_slip_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('mfp_slip') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = mfp_slip_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolved_stress_slip') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = resolved_stress_slip_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('threshold_stress_slip') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = threshold_stress_slip_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('edge_dipole_distance') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = edge_dipole_distance_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('stress_exponent') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = stress_exponent_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('twin_fraction') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = twin_fraction_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_rate_twin','shearrate_twin') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = shear_rate_twin_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulated_shear_twin') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = accumulated_shear_twin_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('mfp_twin') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = mfp_twin_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolved_stress_twin') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = resolved_stress_twin_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('threshold_stress_twin') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = threshold_stress_twin_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolved_stress_shearband') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = resolved_stress_shearband_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_rate_shearband','shearrate_shearband') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = shear_rate_shearband_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('sb_eigenvalues') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = sb_eigenvalues_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('sb_eigenvectors') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = sb_eigenvectors_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('stress_trans_fraction') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = stress_trans_fraction_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('strain_trans_fraction') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = strain_trans_fraction_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('trans_fraction','total_trans_fraction') + plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt + plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = trans_fraction_ID + plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of slip system families + case ('nslip') + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_SlipFamilies + plastic_dislotwin_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('rhoedge0','rhoedgedip0','slipburgers','qedge','v0','clambdaslip','tau_peierls','p_slip','q_slip') + do j = 1_pInt, Nchunks_SlipFamilies + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('rhoedge0') + plastic_dislotwin_rhoEdge0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('rhoedgedip0') + plastic_dislotwin_rhoEdgeDip0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('slipburgers') + plastic_dislotwin_burgersPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('qedge') + plastic_dislotwin_QedgePerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('v0') + plastic_dislotwin_v0PerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('clambdaslip') + plastic_dislotwin_CLambdaSlipPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('tau_peierls') + if (lattice_structure(phase) /= LATTICE_bcc_ID) & + call IO_warning(42_pInt,ext_msg=trim(tag)//' for non-bcc ('//PLASTICITY_DISLOTWIN_label//')') + plastic_dislotwin_tau_peierlsPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('p_slip') + plastic_dislotwin_pPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('q_slip') + plastic_dislotwin_qPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on slip number of twin families + case ('ntwin') + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_TwinFamilies + plastic_dislotwin_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('ndot0_twin','twinsize','twinburgers','r_twin') + do j = 1_pInt, Nchunks_TwinFamilies + tempPerTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('ndot0_twin') + if (lattice_structure(phase) == LATTICE_fcc_ID) & + call IO_warning(42_pInt,ext_msg=trim(tag)//' for fcc ('//PLASTICITY_DISLOTWIN_label//')') + plastic_dislotwin_Ndot0PerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + case ('twinsize') + plastic_dislotwin_twinsizePerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + case ('twinburgers') + plastic_dislotwin_burgersPerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + case ('r_twin') + plastic_dislotwin_rPerTwinFamily(1:Nchunks_TwinFamilies,instance) = tempPerTwin(1:Nchunks_TwinFamilies) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of transformation system families + case ('ntrans') + if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & + call IO_warning(53_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + Nchunks_TransFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_TransFamilies + plastic_dislotwin_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('ndot0_trans','lamellarsize','transburgers','s_trans') + do j = 1_pInt, Nchunks_TransFamilies + tempPerTrans(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('ndot0_trans') + if (lattice_structure(phase) == LATTICE_fcc_ID) & + call IO_warning(42_pInt,ext_msg=trim(tag)//' for fcc ('//PLASTICITY_DISLOTWIN_label//')') + plastic_dislotwin_Ndot0PerTransFamily(1:Nchunks_TransFamilies,instance) = tempPerTrans(1:Nchunks_TransFamilies) + case ('lamellarsize') + plastic_dislotwin_lamellarsizePerTransFamily(1:Nchunks_TransFamilies,instance) = tempPerTrans(1:Nchunks_TransFamilies) + case ('transburgers') + plastic_dislotwin_burgersPerTransFamily(1:Nchunks_TransFamilies,instance) = tempPerTrans(1:Nchunks_TransFamilies) + case ('s_trans') + plastic_dislotwin_sPerTransFamily(1:Nchunks_TransFamilies,instance) = tempPerTrans(1:Nchunks_TransFamilies) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of interactions + case ('interaction_slipslip','interactionslipslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_SlipSlip + plastic_dislotwin_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_sliptwin','interactionsliptwin') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_SlipTwin + plastic_dislotwin_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twinslip','interactiontwinslip') + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_TwinSlip + plastic_dislotwin_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twintwin','interactiontwintwin') + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_TwinTwin + plastic_dislotwin_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_sliptrans','interactionsliptrans') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTrans) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_SlipTrans + plastic_dislotwin_interaction_SlipTrans(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_transslip','interactiontransslip') + if (chunkPos(1) < 1_pInt + Nchunks_TransSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_TransSlip + plastic_dislotwin_interaction_TransSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_transtrans','interactiontranstrans') + if (chunkPos(1) < 1_pInt + Nchunks_TransTrans) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_TransTrans + plastic_dislotwin_interaction_TransTrans(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters independent of number of slip/twin/trans systems + case ('grainsize') + plastic_dislotwin_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('maxtwinfraction') + plastic_dislotwin_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('p_shearband') + plastic_dislotwin_pShearBand(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('q_shearband') + plastic_dislotwin_qShearBand(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('d0') + plastic_dislotwin_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('qsd') + plastic_dislotwin_Qsd(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_rho') + plastic_dislotwin_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_twinfrac') + plastic_dislotwin_aTolTwinFrac(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_transfrac') + plastic_dislotwin_aTolTransFrac(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cmfptwin') + plastic_dislotwin_Cmfptwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cthresholdtwin') + plastic_dislotwin_Cthresholdtwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('solidsolutionstrength') + plastic_dislotwin_SolidSolutionStrength(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('l0_twin') + plastic_dislotwin_L0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('l0_trans') + plastic_dislotwin_L0_trans(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('xc_twin') + plastic_dislotwin_xc_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('xc_trans') + plastic_dislotwin_xc_trans(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('vcrossslip') + plastic_dislotwin_VcrossSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cedgedipmindistance') + plastic_dislotwin_CEdgeDipMinDistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('catomicvolume') + plastic_dislotwin_CAtomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('sfe_0k') + plastic_dislotwin_SFE_0K(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('dsfe_dt') + plastic_dislotwin_dSFE_dT(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('dipoleformationfactor') + plastic_dislotwin_dipoleFormationFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('shearbandresistance') + plastic_dislotwin_sbResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('shearbandvelocity') + plastic_dislotwin_sbVelocity(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('qedgepersbsystem') + plastic_dislotwin_sbQedge(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('deltag') + plastic_dislotwin_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cmfptrans') + plastic_dislotwin_Cmfptrans(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cthresholdtrans') + plastic_dislotwin_Cthresholdtrans(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('transstackheight') + plastic_dislotwin_transStackHeight(instance) = IO_floatValue(line,chunkPos,2_pInt) + end select + endif; endif + enddo parsingFile + + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_dislotwin_ID) then + instance = phase_plasticityInstance(phase) + + if (sum(plastic_dislotwin_Nslip(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='Nslip ('//PLASTICITY_DISLOTWIN_label//')') + if (sum(plastic_dislotwin_Ntwin(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='Ntwin ('//PLASTICITY_DISLOTWIN_label//')') + if (sum(plastic_dislotwin_Ntrans(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='Ntrans ('//PLASTICITY_DISLOTWIN_label//')') + do f = 1_pInt,lattice_maxNslipFamily + if (plastic_dislotwin_Nslip(f,instance) > 0_pInt) then + if (plastic_dislotwin_rhoEdge0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_rhoEdgeDip0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_v0PerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOTWIN_label//')') + endif + enddo + do f = 1_pInt,lattice_maxNtwinFamily + if (plastic_dislotwin_Ntwin(f,instance) > 0_pInt) then + if (plastic_dislotwin_burgersPerTwinFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_Ndot0PerTwinFamily(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='ndot0_twin ('//PLASTICITY_DISLOTWIN_label//')') + endif + enddo + if (plastic_dislotwin_CAtomicVolume(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_D0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_Qsd(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOTWIN_label//')') + if (sum(plastic_dislotwin_Ntwin(:,instance)) > 0_pInt) then + if (abs(plastic_dislotwin_SFE_0K(instance)) <= tiny(0.0_pReal) .and. & + abs(plastic_dislotwin_dSFE_dT(instance)) <= tiny(0.0_pReal) .and. & + lattice_structure(phase) == LATTICE_fcc_ID) & + call IO_error(211_pInt,el=instance,ext_msg='SFE0K ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_aTolRho(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_aTolTwinFrac(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTwinFrac ('//PLASTICITY_DISLOTWIN_label//')') + endif + if (sum(plastic_dislotwin_Ntrans(:,instance)) > 0_pInt) then + if (abs(plastic_dislotwin_SFE_0K(instance)) <= tiny(0.0_pReal) .and. & + abs(plastic_dislotwin_dSFE_dT(instance)) <= tiny(0.0_pReal) .and. & + lattice_structure(phase) == LATTICE_fcc_ID) & + call IO_error(211_pInt,el=instance,ext_msg='SFE0K ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_aTolTransFrac(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTransFrac ('//PLASTICITY_DISLOTWIN_label//')') + endif + if (plastic_dislotwin_sbResistance(instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sbResistance ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_sbVelocity(instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sbVelocity ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_sbVelocity(instance) > 0.0_pReal .and. & + plastic_dislotwin_pShearBand(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='pShearBand ('//PLASTICITY_DISLOTWIN_label//')') + if (abs(plastic_dislotwin_dipoleFormationFactor(instance)) > tiny(0.0_pReal) .and. & + plastic_dislotwin_dipoleFormationFactor(instance) /= 1.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='dipoleFormationFactor ('//PLASTICITY_DISLOTWIN_label//')') + if (plastic_dislotwin_sbVelocity(instance) > 0.0_pReal .and. & + plastic_dislotwin_qShearBand(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='qShearBand ('//PLASTICITY_DISLOTWIN_label//')') + +!-------------------------------------------------------------------------------------------------- +! Determine total number of active slip or twin systems + plastic_dislotwin_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_dislotwin_Nslip(:,instance)) + plastic_dislotwin_Ntwin(:,instance) = min(lattice_NtwinSystem(:,phase),plastic_dislotwin_Ntwin(:,instance)) + plastic_dislotwin_Ntrans(:,instance)= min(lattice_NtransSystem(:,phase),plastic_dislotwin_Ntrans(:,instance)) + plastic_dislotwin_totalNslip(instance) = sum(plastic_dislotwin_Nslip(:,instance)) + plastic_dislotwin_totalNtwin(instance) = sum(plastic_dislotwin_Ntwin(:,instance)) + plastic_dislotwin_totalNtrans(instance) = sum(plastic_dislotwin_Ntrans(:,instance)) + endif myPhase + enddo sanityChecks + +!-------------------------------------------------------------------------------------------------- +! allocation of variables whose size depends on the total number of active slip systems + maxTotalNslip = maxval(plastic_dislotwin_totalNslip) + maxTotalNtwin = maxval(plastic_dislotwin_totalNtwin) + maxTotalNtrans = maxval(plastic_dislotwin_totalNtrans) + + allocate(plastic_dislotwin_burgersPerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_burgersPerTwinSystem(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_burgersPerTransSystem(maxTotalNtrans, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_QedgePerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_v0PerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Ndot0PerTwinSystem(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Ndot0PerTransSystem(maxTotalNtrans, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_tau_r_twin(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_tau_r_trans(maxTotalNtrans, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_twinsizePerTwinSystem(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_CLambdaSlipPerSlipSystem(maxTotalNslip, maxNinstance),source=0.0_pReal) + allocate(plastic_dislotwin_lamellarsizePerTransSystem(maxTotalNtrans, maxNinstance),source=0.0_pReal) + + allocate(plastic_dislotwin_interactionMatrix_SlipSlip(maxval(plastic_dislotwin_totalNslip),& ! slip resistance from slip activity + maxval(plastic_dislotwin_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_interactionMatrix_SlipTwin(maxval(plastic_dislotwin_totalNslip),& ! slip resistance from twin activity + maxval(plastic_dislotwin_totalNtwin),& + maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_interactionMatrix_TwinSlip(maxval(plastic_dislotwin_totalNtwin),& ! twin resistance from slip activity + maxval(plastic_dislotwin_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_interactionMatrix_TwinTwin(maxval(plastic_dislotwin_totalNtwin),& ! twin resistance from twin activity + maxval(plastic_dislotwin_totalNtwin),& + maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_interactionMatrix_SlipTrans(maxval(plastic_dislotwin_totalNslip),& ! slip resistance from trans activity + maxval(plastic_dislotwin_totalNtrans),& + maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_interactionMatrix_TransSlip(maxval(plastic_dislotwin_totalNtrans),& ! trans resistance from slip activity + maxval(plastic_dislotwin_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_interactionMatrix_TransTrans(maxval(plastic_dislotwin_totalNtrans),& ! trans resistance from trans activity + maxval(plastic_dislotwin_totalNtrans),& + maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_projectionMatrix_Trans(maxTotalNtrans,maxTotalNslip,maxNinstance), & + source=0.0_pReal) + allocate(plastic_dislotwin_Ctwin66(6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Ctwin3333(3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Ctrans66(6,6,maxTotalNtrans,maxNinstance), source=0.0_pReal) + allocate(plastic_dislotwin_Ctrans3333(3,3,3,3,maxTotalNtrans,maxNinstance), source=0.0_pReal) + + allocate(state(maxNinstance)) + allocate(state0(maxNinstance)) + allocate(dotState(maxNinstance)) + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + myPhase2: if (phase_plasticity(phase) == PLASTICITY_dislotwin_ID) then + NofMyPhase=count(material_phase==phase) + instance = phase_plasticityInstance(phase) + + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,plastic_dislotwin_Noutput(instance) + select case(plastic_dislotwin_outputID(o,instance)) + case(edge_density_ID, & + dipole_density_ID, & + shear_rate_slip_ID, & + accumulated_shear_slip_ID, & + mfp_slip_ID, & + resolved_stress_slip_ID, & + threshold_stress_slip_ID, & + edge_dipole_distance_ID, & + stress_exponent_ID & + ) + mySize = ns + case(twin_fraction_ID, & + shear_rate_twin_ID, & + accumulated_shear_twin_ID, & + mfp_twin_ID, & + resolved_stress_twin_ID, & + threshold_stress_twin_ID & + ) + mySize = nt + case(resolved_stress_shearband_ID, & + shear_rate_shearband_ID & + ) + mySize = 6_pInt + case(sb_eigenvalues_ID) + mySize = 3_pInt + case(sb_eigenvectors_ID) + mySize = 9_pInt + case(stress_trans_fraction_ID, & + strain_trans_fraction_ID, & + trans_fraction_ID & + ) + mySize = nr + end select + + if (mySize > 0_pInt) then ! any meaningful output found + plastic_dislotwin_sizePostResult(o,instance) = mySize + plastic_dislotwin_sizePostResults(instance) = plastic_dislotwin_sizePostResults(instance) + mySize + endif + enddo outputsLoop + +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + + sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * ns & + + int(size(['twinFraction','accsheartwin']),pInt) * nt & + + int(size(['stressTransFraction','strainTransFraction']),pInt) * nr + sizeDeltaState = 0_pInt + sizeState = sizeDotState & + + int(size(['invLambdaSlip ','invLambdaSlipTwin ','invLambdaSlipTrans',& + 'meanFreePathSlip ','tauSlipThreshold ']),pInt) * ns & + + int(size(['invLambdaTwin ','meanFreePathTwin','tauTwinThreshold',& + 'twinVolume ']),pInt) * nt & + + int(size(['invLambdaTrans ','meanFreePathTrans','tauTransThreshold', & + 'martensiteVolume ']),pInt) * nr + + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_dislotwin_sizePostResults(instance) + plasticState(phase)%nSlip = plastic_dislotwin_totalNslip(instance) + plasticState(phase)%nTwin = plastic_dislotwin_totalNtwin(instance) + plasticState(phase)%nTrans= plastic_dislotwin_totalNtrans(instance) + allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + offset_slip = 2_pInt*plasticState(phase)%nslip + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nslip,1:NofMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nslip,1:NofMyPhase) + + !* Process slip related parameters ------------------------------------------------ + slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(plastic_dislotwin_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list + slipSystemsLoop: do j = 1_pInt,plastic_dislotwin_Nslip(f,instance) + + !* Burgers vector, + ! dislocation velocity prefactor, + ! mean free path prefactor, + ! and minimum dipole distance + + plastic_dislotwin_burgersPerSlipSystem(index_myFamily+j,instance) = & + plastic_dislotwin_burgersPerSlipFamily(f,instance) + + plastic_dislotwin_QedgePerSlipSystem(index_myFamily+j,instance) = & + plastic_dislotwin_QedgePerSlipFamily(f,instance) + + plastic_dislotwin_v0PerSlipSystem(index_myFamily+j,instance) = & + plastic_dislotwin_v0PerSlipFamily(f,instance) + + plastic_dislotwin_CLambdaSlipPerSlipSystem(index_myFamily+j,instance) = & + plastic_dislotwin_CLambdaSlipPerSlipFamily(f,instance) + + !* Calculation of forest projections for edge dislocations + !* Interaction matrices + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_dislotwin_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (slip) + plastic_dislotwin_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,instance) = & + abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,phase))+j,phase), & + lattice_st(:,sum(lattice_NslipSystem(1:o-1,phase))+k,phase))) + plastic_dislotwin_interactionMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_dislotwin_interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_dislotwin_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + plastic_dislotwin_interactionMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_dislotwin_interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtransFamily + index_otherFamily = sum(plastic_dislotwin_Ntrans(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Ntrans(o,instance) ! loop over (active) systems in other family (trans) + plastic_dislotwin_interactionMatrix_SlipTrans(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_dislotwin_interaction_SlipTrans(lattice_interactionSlipTrans( & + sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtransSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo slipSystemsLoop + enddo slipFamiliesLoop + + !* Process twin related parameters ------------------------------------------------ + twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(plastic_dislotwin_Ntwin(1:f-1_pInt,instance)) ! index in truncated twin system list + twinSystemsLoop: do j = 1_pInt,plastic_dislotwin_Ntwin(f,instance) + + !* Burgers vector, + ! nucleation rate prefactor, + ! and twin size + + plastic_dislotwin_burgersPerTwinSystem(index_myFamily+j,instance) = & + plastic_dislotwin_burgersPerTwinFamily(f,instance) + + plastic_dislotwin_Ndot0PerTwinSystem(index_myFamily+j,instance) = & + plastic_dislotwin_Ndot0PerTwinFamily(f,instance) + + plastic_dislotwin_twinsizePerTwinSystem(index_myFamily+j,instance) = & + plastic_dislotwin_twinsizePerTwinFamily(f,instance) + + !* Rotate twin elasticity matrices + index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! 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 + plastic_dislotwin_Ctwin3333(l,m,n,o,index_myFamily+j,instance) = & + plastic_dislotwin_Ctwin3333(l,m,n,o,index_myFamily+j,instance) + & + lattice_C3333(p,q,r,s,instance) * & + lattice_Qtwin(l,p,index_otherFamily+j,phase) * & + lattice_Qtwin(m,q,index_otherFamily+j,phase) * & + lattice_Qtwin(n,r,index_otherFamily+j,phase) * & + lattice_Qtwin(o,s,index_otherFamily+j,phase) + enddo; enddo; enddo; enddo + enddo; enddo; enddo; enddo + plastic_dislotwin_Ctwin66(1:6,1:6,index_myFamily+j,instance) = & + math_Mandel3333to66(plastic_dislotwin_Ctwin3333(1:3,1:3,1:3,1:3,index_myFamily+j,instance)) + + !* Interaction matrices + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_dislotwin_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (slip) + plastic_dislotwin_interactionMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_dislotwin_interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_dislotwin_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + plastic_dislotwin_interactionMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_dislotwin_interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo twinSystemsLoop + enddo twinFamiliesLoop + + !* Process transformation related parameters ------------------------------------------------ + transFamiliesLoop: do f = 1_pInt,lattice_maxNtransFamily + index_myFamily = sum(plastic_dislotwin_Ntrans(1:f-1_pInt,instance)) ! index in truncated trans system list + transSystemsLoop: do j = 1_pInt,plastic_dislotwin_Ntrans(f,instance) + + !* Burgers vector, + ! nucleation rate prefactor, + ! and martensite size + + plastic_dislotwin_burgersPerTransSystem(index_myFamily+j,instance) = & + plastic_dislotwin_burgersPerTransFamily(f,instance) + + plastic_dislotwin_Ndot0PerTransSystem(index_myFamily+j,instance) = & + plastic_dislotwin_Ndot0PerTransFamily(f,instance) + + plastic_dislotwin_lamellarsizePerTransSystem(index_myFamily+j,instance) = & + plastic_dislotwin_lamellarsizePerTransFamily(f,instance) + + !* Rotate trans elasticity matrices + index_otherFamily = sum(lattice_NtransSystem(1:f-1_pInt,phase)) ! index in full lattice trans 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 + plastic_dislotwin_Ctrans3333(l,m,n,o,index_myFamily+j,instance) = & + plastic_dislotwin_Ctrans3333(l,m,n,o,index_myFamily+j,instance) + & + lattice_trans_C3333(p,q,r,s,instance) * & + lattice_Qtrans(l,p,index_otherFamily+j,phase) * & + lattice_Qtrans(m,q,index_otherFamily+j,phase) * & + lattice_Qtrans(n,r,index_otherFamily+j,phase) * & + lattice_Qtrans(o,s,index_otherFamily+j,phase) + enddo; enddo; enddo; enddo + enddo; enddo; enddo; enddo + plastic_dislotwin_Ctrans66(1:6,1:6,index_myFamily+j,instance) = & + math_Mandel3333to66(plastic_dislotwin_Ctrans3333(1:3,1:3,1:3,1:3,index_myFamily+j,instance)) + + !* Interaction matrices + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_dislotwin_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (slip) + plastic_dislotwin_interactionMatrix_TransSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_dislotwin_interaction_TransSlip(lattice_interactionTransSlip( & + sum(lattice_NtransSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtransFamily + index_otherFamily = sum(plastic_dislotwin_Ntrans(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Ntrans(o,instance) ! loop over (active) systems in other family (trans) + plastic_dislotwin_interactionMatrix_TransTrans(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_dislotwin_interaction_TransTrans(lattice_interactionTransTrans( & + sum(lattice_NtransSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtransSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + !* Projection matrices for shear from slip systems to fault-band (twin) systems for strain-induced martensite nucleation + select case(trans_lattice_structure(phase)) + case (LATTICE_bcc_ID) + do o = 1_pInt,lattice_maxNtransFamily + index_otherFamily = sum(plastic_dislotwin_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (trans) + plastic_dislotwin_projectionMatrix_Trans(index_myFamily+j,index_otherFamily+k,instance) = & + lattice_projectionTrans( sum(lattice_NtransSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, phase) + enddo; enddo + end select + + enddo transSystemsLoop + enddo transFamiliesLoop + + startIndex=1_pInt + endIndex=ns + state(instance)%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%rhoEdge=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%rhoEdgeDip=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%accshear_slip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%accshear_slip=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%twinFraction=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%twinFraction=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%twinFraction=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%accshear_twin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%accshear_twin=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nr + state(instance)%stressTransFraction=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%stressTransFraction=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%stressTransFraction=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nr + state(instance)%strainTransFraction=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%strainTransFraction=>plasticState(phase)%state0(startIndex:endIndex,:) + dotState(instance)%strainTransFraction=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%invLambdaSlip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaSlip=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%invLambdaSlipTwin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaSlipTwin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%invLambdaTwin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaTwin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%invLambdaSlipTrans=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaSlipTrans=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nr + state(instance)%invLambdaTrans=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%invLambdaTrans=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%mfp_slip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%mfp_slip=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%mfp_twin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%mfp_twin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nr + state(instance)%mfp_trans=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%mfp_trans=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+ns + state(instance)%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%threshold_stress_slip=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%threshold_stress_twin=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%threshold_stress_twin=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nr + state(instance)%threshold_stress_trans=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%threshold_stress_trans=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nt + state(instance)%twinVolume=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%twinVolume=>plasticState(phase)%state0(startIndex:endIndex,:) + + startIndex=endIndex+1 + endIndex=endIndex+nr + state(instance)%martensiteVolume=>plasticState(phase)%state(startIndex:endIndex,:) + state0(instance)%martensiteVolume=>plasticState(phase)%state0(startIndex:endIndex,:) + + call plastic_dislotwin_stateInit(phase,instance) + call plastic_dislotwin_aTolState(phase,instance) + endif myPhase2 + + enddo initializeInstances +end subroutine plastic_dislotwin_init + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the relevant state values for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_stateInit(ph,instance) + use math, only: & + pi + use lattice, only: & + lattice_maxNslipFamily, & + lattice_mu + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + + real(pReal), dimension(plasticState(ph)%sizeState) :: tempState + + integer(pInt) :: i,j,f,ns,nt,nr, index_myFamily + real(pReal), dimension(plastic_dislotwin_totalNslip(instance)) :: & + rhoEdge0, & + rhoEdgeDip0, & + invLambdaSlip0, & + MeanFreePathSlip0, & + tauSlipThreshold0 + real(pReal), dimension(plastic_dislotwin_totalNtwin(instance)) :: & + MeanFreePathTwin0,TwinVolume0 + real(pReal), dimension(plastic_dislotwin_totalNtrans(instance)) :: & + MeanFreePathTrans0,MartensiteVolume0 + tempState = 0.0_pReal + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + +!-------------------------------------------------------------------------------------------------- +! initialize basic slip state variables + do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(plastic_dislotwin_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list + rhoEdge0(index_myFamily+1_pInt: & + index_myFamily+plastic_dislotwin_Nslip(f,instance)) = & + plastic_dislotwin_rhoEdge0(f,instance) + rhoEdgeDip0(index_myFamily+1_pInt: & + index_myFamily+plastic_dislotwin_Nslip(f,instance)) = & + plastic_dislotwin_rhoEdgeDip0(f,instance) + enddo + + tempState(1_pInt:ns) = rhoEdge0 + tempState(ns+1_pInt:2_pInt*ns) = rhoEdgeDip0 + +!-------------------------------------------------------------------------------------------------- +! initialize dependent slip microstructural variables + forall (i = 1_pInt:ns) & + invLambdaSlip0(i) = sqrt(dot_product((rhoEdge0+rhoEdgeDip0),plastic_dislotwin_forestProjectionEdge(1:ns,i,instance)))/ & + plastic_dislotwin_CLambdaSlipPerSlipSystem(i,instance) + tempState(3_pInt*ns+2_pInt*nt+2_pInt*nr+1:4_pInt*ns+2_pInt*nt+2_pInt*nr) = invLambdaSlip0 + + forall (i = 1_pInt:ns) & + MeanFreePathSlip0(i) = & + plastic_dislotwin_GrainSize(instance)/(1.0_pReal+invLambdaSlip0(i)*plastic_dislotwin_GrainSize(instance)) + tempState(6_pInt*ns+3_pInt*nt+3_pInt*nr+1:7_pInt*ns+3_pInt*nt+3_pInt*nr) = MeanFreePathSlip0 + + forall (i = 1_pInt:ns) & + tauSlipThreshold0(i) = & + lattice_mu(ph)*plastic_dislotwin_burgersPerSlipSystem(i,instance) * & + sqrt(dot_product((rhoEdge0+rhoEdgeDip0),plastic_dislotwin_interactionMatrix_SlipSlip(i,1:ns,instance))) + + tempState(7_pInt*ns+4_pInt*nt+4_pInt*nr+1:8_pInt*ns+4_pInt*nt+4_pInt*nr) = tauSlipThreshold0 + +!-------------------------------------------------------------------------------------------------- +! initialize dependent twin microstructural variables + forall (j = 1_pInt:nt) & + MeanFreePathTwin0(j) = plastic_dislotwin_GrainSize(instance) + tempState(7_pInt*ns+3_pInt*nt+3_pInt*nr+1_pInt:7_pInt*ns+4_pInt*nt+3_pInt*nr) = MeanFreePathTwin0 + + forall (j = 1_pInt:nt) & + TwinVolume0(j) = & + (pi/4.0_pReal)*plastic_dislotwin_twinsizePerTwinSystem(j,instance)*MeanFreePathTwin0(j)**(2.0_pReal) + tempState(8_pInt*ns+5_pInt*nt+5_pInt*nr+1_pInt:8_pInt*ns+6_pInt*nt+5_pInt*nr) = TwinVolume0 + +!-------------------------------------------------------------------------------------------------- +! initialize dependent trans microstructural variables + forall (j = 1_pInt:nr) & + MeanFreePathTrans0(j) = plastic_dislotwin_GrainSize(instance) + tempState(7_pInt*ns+4_pInt*nt+3_pInt*nr+1_pInt:7_pInt*ns+4_pInt*nt+4_pInt*nr) = MeanFreePathTrans0 + + forall (j = 1_pInt:nr) & + MartensiteVolume0(j) = & + (pi/4.0_pReal)*plastic_dislotwin_lamellarsizePerTransSystem(j,instance)*MeanFreePathTrans0(j)**(2.0_pReal) + tempState(8_pInt*ns+6_pInt*nt+5_pInt*nr+1_pInt:8_pInt*ns+6_pInt*nt+6_pInt*nr) = MartensiteVolume0 + +plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) + +end subroutine plastic_dislotwin_stateInit + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the relevant state values for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_aTolState(ph,instance) + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + ph, & + instance ! number specifying the current instance of the plasticity + + integer(pInt) :: ns, nt, nr + + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + + ! Tolerance state for dislocation densities + plasticState(ph)%aTolState(1_pInt: & + 2_pInt*ns) = plastic_dislotwin_aTolRho(instance) + + ! Tolerance state for accumulated shear due to slip + plasticState(ph)%aTolState(2_pInt*ns+1_pInt: & + 3_pInt*ns)=1.0e6_pReal + + ! Tolerance state for twin volume fraction + plasticState(ph)%aTolState(3_pInt*ns+1_pInt: & + 3_pInt*ns+nt) = plastic_dislotwin_aTolTwinFrac(instance) + + ! Tolerance state for accumulated shear due to twin + plasticState(ph)%aTolState(3_pInt*ns+nt+1_pInt: & + 3_pInt*ns+2_pInt*nt) = 1.0e6_pReal + +! Tolerance state for stress-assisted martensite volume fraction + plasticState(ph)%aTolState(3_pInt*ns+2_pInt*nt+1_pInt: & + 3_pInt*ns+2_pInt*nt+nr) = plastic_dislotwin_aTolTransFrac(instance) + +! Tolerance state for strain-induced martensite volume fraction + plasticState(ph)%aTolState(3_pInt*ns+2_pInt*nt+nr+1_pInt: & + 3_pInt*ns+2_pInt*nt+2_pInt*nr) = plastic_dislotwin_aTolTransFrac(instance) + +end subroutine plastic_dislotwin_aTolState + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns the homogenized elasticity matrix +!-------------------------------------------------------------------------------------------------- +function plastic_dislotwin_homogenizedC(ipc,ip,el) + use material, only: & + phase_plasticityInstance, & + phaseAt, phasememberAt + use lattice, only: & + lattice_C66 + + implicit none + real(pReal), dimension(6,6) :: & + plastic_dislotwin_homogenizedC + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + + integer(pInt) :: instance,ns,nt,nr,i, & + ph, & + of + real(pReal) :: sumf, sumftr + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + + !* Total transformed volume fraction + sumftr = sum(state(instance)%stressTransFraction(1_pInt:nr,of)) + & + sum(state(instance)%strainTransFraction(1_pInt:nr,of)) + + !* Homogenized elasticity matrix + plastic_dislotwin_homogenizedC = (1.0_pReal-sumf-sumftr)*lattice_C66(1:6,1:6,ph) + do i=1_pInt,nt + plastic_dislotwin_homogenizedC = plastic_dislotwin_homogenizedC & + + state(instance)%twinFraction(i,of)*plastic_dislotwin_Ctwin66(1:6,1:6,i,instance) + enddo + do i=1_pInt,nr + plastic_dislotwin_homogenizedC = plastic_dislotwin_homogenizedC & + + (state(instance)%stressTransFraction(i,of) + state(instance)%strainTransFraction(i,of))*& + plastic_dislotwin_Ctrans66(1:6,1:6,i,instance) + enddo + + end function plastic_dislotwin_homogenizedC + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_microstructure(temperature,ipc,ip,el) + use math, only: & + pi + use material, only: & + material_phase, & + phase_plasticityInstance, & + !plasticState, & !!!!delete + phaseAt, phasememberAt + use lattice, only: & + lattice_mu, & + lattice_nu + + 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 + + integer(pInt) :: & + instance, & + ns,nt,nr,s,t,r, & + ph, & + of + real(pReal) :: & + sumf,sfe,x0,sumftr + real(pReal), dimension(plastic_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: fOverStacksize + real(pReal), dimension(plastic_dislotwin_totalNtrans(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + ftransOverLamellarSize + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + + !* Total transformed volume fraction + sumftr = sum(state(instance)%stressTransFraction(1_pInt:nr,of)) + & + sum(state(instance)%strainTransFraction(1_pInt:nr,of)) + + !* Stacking fault energy + sfe = plastic_dislotwin_SFE_0K(instance) + & + plastic_dislotwin_dSFE_dT(instance) * Temperature + + !* rescaled twin volume fraction for topology + forall (t = 1_pInt:nt) & + fOverStacksize(t) = & + state(instance)%twinFraction(t,of)/plastic_dislotwin_twinsizePerTwinSystem(t,instance) + + !* rescaled trans volume fraction for topology + forall (r = 1_pInt:nr) & + ftransOverLamellarSize(r) = & + (state(instance)%stressTransFraction(r,of)+state(instance)%strainTransFraction(r,of))/& + plastic_dislotwin_lamellarsizePerTransSystem(r,instance) + + !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation + forall (s = 1_pInt:ns) & + state(instance)%invLambdaSlip(s,of) = & + sqrt(dot_product((state(instance)%rhoEdge(1_pInt:ns,of)+state(instance)%rhoEdgeDip(1_pInt:ns,of)),& + plastic_dislotwin_forestProjectionEdge(1:ns,s,instance)))/ & + plastic_dislotwin_CLambdaSlipPerSlipSystem(s,instance) + + !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation + !$OMP CRITICAL (evilmatmul) + state(instance)%invLambdaSlipTwin(1_pInt:ns,of) = 0.0_pReal + if (nt > 0_pInt .and. ns > 0_pInt) & + state(instance)%invLambdaSlipTwin(1_pInt:ns,of) = & + matmul(plastic_dislotwin_interactionMatrix_SlipTwin(1:ns,1:nt,instance),fOverStacksize(1:nt))/(1.0_pReal-sumf) + !$OMP END CRITICAL (evilmatmul) + + !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + !$OMP CRITICAL (evilmatmul) + if (nt > 0_pInt) & + state(instance)%invLambdaTwin(1_pInt:nt,of) = & + matmul(plastic_dislotwin_interactionMatrix_TwinTwin(1:nt,1:nt,instance),fOverStacksize(1:nt))/(1.0_pReal-sumf) + !$OMP END CRITICAL (evilmatmul) + + !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation + state(instance)%invLambdaSlipTrans(1_pInt:ns,of) = 0.0_pReal + if (nr > 0_pInt .and. ns > 0_pInt) & + state(instance)%invLambdaSlipTrans(1_pInt:ns,of) = & + matmul(plastic_dislotwin_interactionMatrix_SlipTrans(1:ns,1:nr,instance),ftransOverLamellarSize(1:nr))/(1.0_pReal-sumftr) + + !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) + if (nr > 0_pInt) & + state(instance)%invLambdaTrans(1_pInt:nr,of) = & + matmul(plastic_dislotwin_interactionMatrix_TransTrans(1:nr,1:nr,instance),ftransOverLamellarSize(1:nr))/(1.0_pReal-sumftr) + + !* mean free path between 2 obstacles seen by a moving dislocation + do s = 1_pInt,ns + if ((nt > 0_pInt) .or. (nr > 0_pInt)) then + state(instance)%mfp_slip(s,of) = & + plastic_dislotwin_GrainSize(instance)/(1.0_pReal+plastic_dislotwin_GrainSize(instance)*& + (state(instance)%invLambdaSlip(s,of) + & + state(instance)%invLambdaSlipTwin(s,of) + & + state(instance)%invLambdaSlipTrans(s,of))) + else + state(instance)%mfp_slip(s,of) = & + plastic_dislotwin_GrainSize(instance)/& + (1.0_pReal+plastic_dislotwin_GrainSize(instance)*(state(instance)%invLambdaSlip(s,of))) !!!!!! correct? + endif + enddo + + !* mean free path between 2 obstacles seen by a growing twin + forall (t = 1_pInt:nt) & + state(instance)%mfp_twin(t,of) = & + plastic_dislotwin_Cmfptwin(instance)*plastic_dislotwin_GrainSize(instance)/& + (1.0_pReal+plastic_dislotwin_GrainSize(instance)*state(ph)%invLambdaTwin(t,of)) + + !* mean free path between 2 obstacles seen by a growing martensite + forall (r = 1_pInt:nr) & + state(instance)%mfp_trans(r,of) = & + plastic_dislotwin_Cmfptrans(instance)*plastic_dislotwin_GrainSize(instance)/& + (1.0_pReal+plastic_dislotwin_GrainSize(instance)*state(instance)%invLambdaTrans(r,of)) + + !* threshold stress for dislocation motion + forall (s = 1_pInt:ns) & + state(instance)%threshold_stress_slip(s,of) = & + lattice_mu(ph)*plastic_dislotwin_burgersPerSlipSystem(s,instance)*& + sqrt(dot_product((state(instance)%rhoEdge(1_pInt:ns,of)+state(instance)%rhoEdgeDip(1_pInt:ns,of)),& + plastic_dislotwin_interactionMatrix_SlipSlip(s,1:ns,instance))) + + !* threshold stress for growing twin + forall (t = 1_pInt:nt) & + state(instance)%threshold_stress_twin(t,of) = & + plastic_dislotwin_Cthresholdtwin(instance)* & + (sfe/(3.0_pReal*plastic_dislotwin_burgersPerTwinSystem(t,instance)) & + + 3.0_pReal*plastic_dislotwin_burgersPerTwinSystem(t,instance)*lattice_mu(ph)/& + (plastic_dislotwin_L0_twin(instance)*plastic_dislotwin_burgersPerSlipSystem(t,instance)) & + ) + + !* threshold stress for growing martensite + forall (r = 1_pInt:nr) & + state(instance)%threshold_stress_trans(r,of) = & + plastic_dislotwin_Cthresholdtrans(instance)* & + (sfe/(3.0_pReal*plastic_dislotwin_burgersPerTransSystem(r,instance)) & + + 3.0_pReal*plastic_dislotwin_burgersPerTransSystem(r,instance)*lattice_mu(ph)/& + (plastic_dislotwin_L0_trans(instance)*plastic_dislotwin_burgersPerSlipSystem(r,instance))& + + plastic_dislotwin_transStackHeight(instance)*plastic_dislotwin_deltaG(instance)/ & + (3.0_pReal*plastic_dislotwin_burgersPerTransSystem(r,instance)) & + ) + + !* final twin volume after growth + forall (t = 1_pInt:nt) & + state(instance)%twinVolume(t,of) = & + (pi/4.0_pReal)*plastic_dislotwin_twinsizePerTwinSystem(t,instance)*& + state(instance)%mfp_twin(t,of)**(2.0_pReal) + + !* final martensite volume after growth + forall (r = 1_pInt:nr) & + state(instance)%martensiteVolume(r,of) = & + (pi/4.0_pReal)*plastic_dislotwin_lamellarsizePerTransSystem(r,instance)*& + state(instance)%mfp_trans(r,of)**(2.0_pReal) + + !* equilibrium separation of partial dislocations (twin) + do t = 1_pInt,nt + x0 = lattice_mu(ph)*plastic_dislotwin_burgersPerTwinSystem(t,instance)**(2.0_pReal)/& + (sfe*8.0_pReal*pi)*(2.0_pReal+lattice_nu(ph))/(1.0_pReal-lattice_nu(ph)) + plastic_dislotwin_tau_r_twin(t,instance)= & + lattice_mu(ph)*plastic_dislotwin_burgersPerTwinSystem(t,instance)/(2.0_pReal*pi)*& + (1/(x0+plastic_dislotwin_xc_twin(instance))+cos(pi/3.0_pReal)/x0) + enddo + + !* equilibrium separation of partial dislocations (trans) + do r = 1_pInt,nr + x0 = lattice_mu(ph)*plastic_dislotwin_burgersPerTransSystem(r,instance)**(2.0_pReal)/& + (sfe*8.0_pReal*pi)*(2.0_pReal+lattice_nu(ph))/(1.0_pReal-lattice_nu(ph)) + plastic_dislotwin_tau_r_trans(r,instance)= & + lattice_mu(ph)*plastic_dislotwin_burgersPerTransSystem(r,instance)/(2.0_pReal*pi)*& + (1/(x0+plastic_dislotwin_xc_trans(instance))+cos(pi/3.0_pReal)/x0) + enddo + +end subroutine plastic_dislotwin_microstructure + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature,ipc,ip,el) + use prec, only: & + tol_math_check + use math, only: & + math_Plain3333to99, & + math_Mandel6to33, & + math_Mandel33to6, & + math_spectralDecompositionSym, & + math_tensorproduct33, & + math_symmetric33, & + math_mul33x3 + use material, only: & + material_phase, & + phase_plasticityInstance, & + phaseAt, phasememberAt + use lattice, only: & + lattice_Sslip, & + lattice_Sslip_v, & + lattice_Stwin, & + lattice_Stwin_v, & + lattice_Strans, & + lattice_Strans_v, & + lattice_maxNslipFamily,& + lattice_maxNtwinFamily, & + lattice_maxNtransFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NtransSystem, & + lattice_shearTwin, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & + LATTICE_fcc_ID + + implicit none + integer(pInt), intent(in) :: ipc,ip,el + real(pReal), intent(in) :: Temperature + real(pReal), dimension(6), intent(in) :: Tstar_v + real(pReal), dimension(3,3), intent(out) :: Lp + real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 + + integer(pInt) :: instance,ph,of,ns,nt,nr,f,i,j,k,l,m,n,index_myFamily,s1,s2 + real(pReal) :: sumf,sumftr,StressRatio_p,StressRatio_pminus1,StressRatio_r,BoltzmannRatio,DotGamma0,Ndot0_twin,stressRatio, & + Ndot0_trans,StressRatio_s + real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 + real(pReal), dimension(plastic_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip,dgdot_dtauslip,tau_slip + real(pReal), dimension(plastic_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_twin,dgdot_dtautwin,tau_twin + real(pReal), dimension(plastic_dislotwin_totalNtrans(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_trans,dgdot_dtautrans,tau_trans + 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 + logical :: error + 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]) + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + + Lp = 0.0_pReal + dLp_dTstar3333 = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! Dislocation glide part + gdot_slip = 0.0_pReal + dgdot_dtauslip = 0.0_pReal + j = 0_pInt + slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystemsLoop: do i = 1_pInt,plastic_dislotwin_Nslip(f,instance) + j = j+1_pInt + + !* Calculation of Lp + !* Resolved shear stress on slip system + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + + if((abs(tau_slip(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratios + stressRatio =((abs(tau_slip(j))- state(instance)%threshold_stress_slip(j,of))/& + (plastic_dislotwin_SolidSolutionStrength(instance)+plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance))) + StressRatio_p = stressRatio** plastic_dislotwin_pPerSlipFamily(f,instance) + StressRatio_pminus1 = stressRatio**(plastic_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) + !* Boltzmann ratio + BoltzmannRatio = plastic_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(instance)%rhoEdge(j,of)*plastic_dislotwin_burgersPerSlipSystem(j,instance)*& + plastic_dislotwin_v0PerSlipSystem(j,instance) + + !* Shear rates due to slip + gdot_slip(j) = DotGamma0 & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_dislotwin_qPerSlipFamily(f,instance)) & + * sign(1.0_pReal,tau_slip(j)) + + !* Derivatives of shear rates + dgdot_dtauslip(j) = & + abs(gdot_slip(j))*BoltzmannRatio*plastic_dislotwin_pPerSlipFamily(f,instance)& + *plastic_dislotwin_qPerSlipFamily(f,instance)/& + (plastic_dislotwin_SolidSolutionStrength(instance)+plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_dislotwin_qPerSlipFamily(f,instance)-1.0_pReal) + endif + + !* Plastic velocity gradient for dislocation glide + Lp = Lp + gdot_slip(j)*lattice_Sslip(:,:,1,index_myFamily+i,ph) + + !* Calculation of the tangent of Lp + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtauslip(j)*& + lattice_Sslip(k,l,1,index_myFamily+i,ph)*& + lattice_Sslip(m,n,1,index_myFamily+i,ph) + enddo slipSystemsLoop + enddo slipFamiliesLoop + +!-------------------------------------------------------------------------------------------------- +! correct Lp and dLp_dTstar3333 for twinned and transformed fraction + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + + !* Total transformed volume fraction + sumftr = sum(state(instance)%stressTransFraction(1_pInt:nr,of)) + & + sum(state(instance)%strainTransFraction(1_pInt:nr,of)) + Lp = Lp * (1.0_pReal - sumf - sumftr) + dLp_dTstar3333 = dLp_dTstar3333 * (1.0_pReal - sumf - sumftr) + +!-------------------------------------------------------------------------------------------------- +! Shear banding (shearband) part + if(abs(plastic_dislotwin_sbVelocity(instance)) > tiny(0.0_pReal) .and. & + abs(plastic_dislotwin_sbResistance(instance)) > tiny(0.0_pReal)) then + gdot_sb = 0.0_pReal + dgdot_dtausb = 0.0_pReal + call math_spectralDecompositionSym(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_tensorproduct33(sb_s,sb_m) + plastic_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,plastic_dislotwin_sbSv(1:6,j,ipc,ip,el)) + + !* Stress ratios + if (abs(tau_sb(j)) < tol_math_check) then + StressRatio_p = 0.0_pReal + StressRatio_pminus1 = 0.0_pReal + else + StressRatio_p = (abs(tau_sb(j))/plastic_dislotwin_sbResistance(instance))& + **plastic_dislotwin_pShearBand(instance) + StressRatio_pminus1 = (abs(tau_sb(j))/plastic_dislotwin_sbResistance(instance))& + **(plastic_dislotwin_pShearBand(instance)-1.0_pReal) + endif + + !* Boltzmann ratio + BoltzmannRatio = plastic_dislotwin_sbQedge(instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = plastic_dislotwin_sbVelocity(instance) + + !* Shear rates due to shearband + gdot_sb(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& + plastic_dislotwin_qShearBand(instance))*sign(1.0_pReal,tau_sb(j)) + + !* Derivatives of shear rates + dgdot_dtausb(j) = & + ((abs(gdot_sb(j))*BoltzmannRatio*& + plastic_dislotwin_pShearBand(instance)*plastic_dislotwin_qShearBand(instance))/& + plastic_dislotwin_sbResistance(instance))*& + StressRatio_pminus1*(1_pInt-StressRatio_p)**(plastic_dislotwin_qShearBand(instance)-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 + twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystemsLoop: do i = 1_pInt,plastic_dislotwin_Ntwin(f,instance) + j = j+1_pInt + + !* Calculation of Lp + !* Resolved shear stress on twin system + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + + !* Stress ratios + if (tau_twin(j) > tol_math_check) then + StressRatio_r = (state(instance)%threshold_stress_twin(j,of)/tau_twin(j))**plastic_dislotwin_rPerTwinFamily(f,instance) + !* Shear rates and their derivatives due to twin + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_twin(j) < plastic_dislotwin_tau_r_twin(j,instance)) then + Ndot0_twin=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(ph)%rhoEdgeDip(s2,of))+& !!!!! correct? + abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_dislotwin_L0_twin(instance)*plastic_dislotwin_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_dislotwin_tau_r_twin(j,instance)-tau_twin(j)))) + else + Ndot0_twin=0.0_pReal + end if + case default + Ndot0_twin=plastic_dislotwin_Ndot0PerTwinSystem(j,instance) + end select + gdot_twin(j) = & + (1.0_pReal-sumf-sumftr)*lattice_shearTwin(index_myFamily+i,ph)*& + state(instance)%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) + dgdot_dtautwin(j) = ((gdot_twin(j)*plastic_dislotwin_rPerTwinFamily(f,instance))/tau_twin(j))*StressRatio_r + endif + + !* Plastic velocity gradient for mechanical twinning + Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) + + !* Calculation of the tangent of Lp + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin(j)*& + lattice_Stwin(k,l,index_myFamily+i,ph)*& + lattice_Stwin(m,n,index_myFamily+i,ph) + enddo twinSystemsLoop + enddo twinFamiliesLoop + + !* Phase transformation part + gdot_trans = 0.0_pReal + dgdot_dtautrans = 0.0_pReal + j = 0_pInt + transFamiliesLoop: do f = 1_pInt,lattice_maxNtransFamily + index_myFamily = sum(lattice_NtransSystem(1:f-1_pInt,ph)) ! at which index starts my family + transSystemsLoop: do i = 1_pInt,plastic_dislotwin_Ntrans(f,instance) + j = j+1_pInt + + !* Resolved shear stress on transformation system + tau_trans(j) = dot_product(Tstar_v,lattice_Strans_v(:,index_myFamily+i,ph)) + + !* Stress ratios + if (tau_trans(j) > tol_math_check) then + StressRatio_s = (state(instance)%threshold_stress_trans(j,of)/tau_trans(j))**plastic_dislotwin_sPerTransFamily(f,instance) + !* Shear rates and their derivatives due to transformation + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_trans(j) < plastic_dislotwin_tau_r_trans(j,instance)) then + Ndot0_trans=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& !!!!! correct? + abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_dislotwin_L0_trans(instance)*plastic_dislotwin_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_dislotwin_tau_r_trans(j,instance)-tau_trans(j)))) + else + Ndot0_trans=0.0_pReal + end if + case default + Ndot0_trans=plastic_dislotwin_Ndot0PerTransSystem(j,instance) + end select + gdot_trans(j) = & + (1.0_pReal-sumf-sumftr)*& + state(instance)%martensiteVolume(j,of)*Ndot0_trans*exp(-StressRatio_s) + dgdot_dtautrans(j) = ((gdot_trans(j)*plastic_dislotwin_sPerTransFamily(f,instance))/tau_trans(j))*StressRatio_s + endif + + !* Plastic velocity gradient for phase transformation + Lp = Lp + gdot_trans(j)*lattice_Strans(:,:,index_myFamily+i,ph) + + !* Calculation of the tangent of Lp + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtautrans(j)*& + lattice_Strans(k,l,index_myFamily+i,ph)*& + lattice_Strans(m,n,index_myFamily+i,ph) + + enddo transSystemsLoop + enddo transFamiliesLoop + + dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) + +end subroutine plastic_dislotwin_LpAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_dotState(Tstar_v,Temperature,ipc,ip,el) + use prec, only: & + tol_math_check + use math, only: & + pi + use material, only: & + material_phase, & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_Strans_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_maxNtransFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NtransSystem, & + lattice_sheartwin, & + lattice_mu, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & + lattice_fccTobcc_transNucleationTwinPair, & + lattice_fccTobcc_shearCritTrans, & + LATTICE_fcc_ID + + 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 + + integer(pInt) :: instance,ns,nt,nr,f,i,j,index_myFamily,s1,s2, & + ph, & + of + real(pReal) :: sumf,sumftr,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,& + EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,StressRatio_r,Ndot0_twin,stressRatio,& + Ndot0_trans,StressRatio_s,EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & + DotRhoDipFormation,DotRhoMultiplication,DotRhoEdgeEdgeAnnihilation + real(pReal), dimension(plastic_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip,tau_slip + + real(pReal), dimension(plastic_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + tau_twin + real(pReal), dimension(plastic_dislotwin_totalNtrans(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + tau_trans + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + plasticState(instance)%dotState(:,of) = 0.0_pReal + + !* Total transformed volume fraction + sumftr = sum(state(instance)%stressTransFraction(1_pInt:nr,of)) + & + sum(state(instance)%strainTransFraction(1_pInt:nr,of)) + + !* 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,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j+1_pInt + + !* Resolved shear stress on slip system + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + + if((abs(tau_slip(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratios + stressRatio =((abs(tau_slip(j))- state(instance)%threshold_stress_slip(j,of))/& + (plastic_dislotwin_SolidSolutionStrength(instance)+plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance))) + StressRatio_p = stressRatio** plastic_dislotwin_pPerSlipFamily(f,instance) + StressRatio_pminus1 = stressRatio**(plastic_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) + !* Boltzmann ratio + BoltzmannRatio = plastic_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + plasticState(ph)%state(j, of)*plastic_dislotwin_burgersPerSlipSystem(j,instance)*& + plastic_dislotwin_v0PerSlipSystem(j,instance) + + !* Shear rates due to slip + gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)** & + plastic_dislotwin_qPerSlipFamily(f,instance))*sign(1.0_pReal,tau_slip(j)) + endif + !* Multiplication + DotRhoMultiplication = abs(gdot_slip(j))/& + (plastic_dislotwin_burgersPerSlipSystem(j,instance)*state(instance)%mfp_slip(j,of)) + !* Dipole formation + EdgeDipMinDistance = & + plastic_dislotwin_CEdgeDipMinDistance(instance)*plastic_dislotwin_burgersPerSlipSystem(j,instance) + if (abs(tau_slip(j)) <= tiny(0.0_pReal)) then + DotRhoDipFormation = 0.0_pReal + else + EdgeDipDistance = & + (3.0_pReal*lattice_mu(ph)*plastic_dislotwin_burgersPerSlipSystem(j,instance))/& + (16.0_pReal*pi*abs(tau_slip(j))) + if (EdgeDipDistance>state(instance)%mfp_slip(j,of)) EdgeDipDistance=state(instance)%mfp_slip(j,of) + if (EdgeDipDistance tol_math_check) then + StressRatio_r = (state(instance)%threshold_stress_twin(j,of)/& + tau_twin(j))**plastic_dislotwin_rPerTwinFamily(f,instance) + !* Shear rates and their derivatives due to twin + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_twin(j) < plastic_dislotwin_tau_r_twin(j,instance)) then + Ndot0_twin=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_dislotwin_L0_twin(instance)*plastic_dislotwin_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_dislotwin_tau_r_twin(j,instance)-tau_twin(j)))) + else + Ndot0_twin=0.0_pReal + end if + case default + Ndot0_twin=plastic_dislotwin_Ndot0PerTwinSystem(j,instance) + end select + dotState(instance)%twinFraction(j,of) = & + (1.0_pReal-sumf-sumftr)*& + state(instance)%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) + !* Dotstate for accumulated shear due to twin + dotState(instance)%accshear_twin(j,of) = dotState(instance)%twinFraction(j,of) * & + lattice_sheartwin(index_myfamily+i,ph) + endif + enddo + enddo + + !* Transformation volume fraction evolution + j = 0_pInt + do f = 1_pInt,lattice_maxNtransFamily ! loop over all trans families + index_myFamily = sum(lattice_NtransSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Ntrans(f,instance) ! process each (active) trans system in family + j = j+1_pInt + + !* Resolved shear stress on transformation system + tau_trans(j) = dot_product(Tstar_v,lattice_Strans_v(:,index_myFamily+i,ph)) + + !* Stress ratios + if (tau_trans(j) > tol_math_check) then + StressRatio_s = (state(instance)%threshold_stress_trans(j,of)/& + tau_trans(j))**plastic_dislotwin_sPerTransFamily(f,instance) + !* Shear rates and their derivatives due to transformation + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_trans(j) < plastic_dislotwin_tau_r_trans(j,instance)) then + Ndot0_trans=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_dislotwin_L0_trans(instance)*plastic_dislotwin_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_dislotwin_tau_r_trans(j,instance)-tau_trans(j)))) + else + Ndot0_trans=0.0_pReal + end if + case default + Ndot0_trans=plastic_dislotwin_Ndot0PerTransSystem(j,instance) + end select + dotState(instance)%strainTransFraction(j,of) = & + (1.0_pReal-sumf-sumftr)*& + state(instance)%martensiteVolume(j,of)*Ndot0_trans*exp(-StressRatio_s) + !* Dotstate for accumulated shear due to transformation + !dotState(instance)%accshear_trans(j,of) = dotState(instance)%strainTransFraction(j,of) * & + ! lattice_sheartrans(index_myfamily+i,ph) + endif + + enddo + enddo + +end subroutine plastic_dislotwin_dotState + + + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_dislotwin_postResults(Tstar_v,Temperature,ipc,ip,el) + use prec, only: & + tol_math_check + use math, only: & + pi, & + math_Mandel6to33, & + math_eigenvaluesSym33, & + math_spectralDecompositionSym33 + use material, only: & + material_phase, & + phase_plasticityInstance,& + phaseAt, phasememberAt + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_shearTwin, & + lattice_mu, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & + LATTICE_fcc_ID + + 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 + + real(pReal), dimension(plastic_dislotwin_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_dislotwin_postResults + integer(pInt) :: & + instance,& + ns,nt,nr,& + f,o,i,c,j,index_myFamily,& + s1,s2, & + ph, & + of + real(pReal) :: sumf,tau,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,StressRatio_r,Ndot0_twin,dgdot_dtauslip, & + stressRatio + real(preal), dimension(plastic_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip + real(pReal), dimension(3,3) :: eigVectors + real(pReal), dimension (3) :: eigValues + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_dislotwin_totalNslip(instance) + nt = plastic_dislotwin_totalNtwin(instance) + nr = plastic_dislotwin_totalNtrans(instance) + + !* Total twin volume fraction + sumf = sum(state(instance)%twinFraction(1_pInt:nt,of)) ! safe for nt == 0 + + !* Required output + c = 0_pInt + plastic_dislotwin_postResults = 0.0_pReal + do o = 1_pInt,plastic_dislotwin_Noutput(instance) + select case(plastic_dislotwin_outputID(o,instance)) + + case (edge_density_ID) + plastic_dislotwin_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdge(1_pInt:ns,of) + c = c + ns + case (dipole_density_ID) + plastic_dislotwin_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) + c = c + ns + case (shear_rate_slip_ID) + j = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j + 1_pInt ! could be taken from state by now! + + !* Resolved shear stress on slip system + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + !* Stress ratios + if((abs(tau)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratios + stressRatio = ((abs(tau)-state(ph)%threshold_stress_slip(j,of))/& + (plastic_dislotwin_SolidSolutionStrength(instance)+& + plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance))) + StressRatio_p = stressRatio** plastic_dislotwin_pPerSlipFamily(f,instance) + StressRatio_pminus1 = stressRatio**(plastic_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) + !* Boltzmann ratio + BoltzmannRatio = plastic_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(instance)%rhoEdge(j,of)*plastic_dislotwin_burgersPerSlipSystem(j,instance)* & + plastic_dislotwin_v0PerSlipSystem(j,instance) + + !* Shear rates due to slip + plastic_dislotwin_postResults(c+j) = & + DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& + plastic_dislotwin_qPerSlipFamily(f,instance))*sign(1.0_pReal,tau) + else + plastic_dislotwin_postResults(c+j) = 0.0_pReal + endif + + enddo ; enddo + c = c + ns + case (accumulated_shear_slip_ID) + plastic_dislotwin_postResults(c+1_pInt:c+ns) = & + state(instance)%accshear_slip(1_pInt:ns,of) + c = c + ns + case (mfp_slip_ID) + plastic_dislotwin_postResults(c+1_pInt:c+ns) =& + state(instance)%mfp_slip(1_pInt:ns,of) + c = c + ns + case (resolved_stress_slip_ID) + j = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j + 1_pInt + plastic_dislotwin_postResults(c+j) =& + dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + enddo; enddo + c = c + ns + case (threshold_stress_slip_ID) + plastic_dislotwin_postResults(c+1_pInt:c+ns) = & + state(instance)%threshold_stress_slip(1_pInt:ns,of) + c = c + ns + case (edge_dipole_distance_ID) + j = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j + 1_pInt + plastic_dislotwin_postResults(c+j) = & + (3.0_pReal*lattice_mu(ph)*plastic_dislotwin_burgersPerSlipSystem(j,instance))/& + (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) + plastic_dislotwin_postResults(c+j)=min(plastic_dislotwin_postResults(c+j),& + state(instance)%mfp_slip(j,of)) + ! plastic_dislotwin_postResults(c+j)=max(plastic_dislotwin_postResults(c+j),& + ! plasticState(ph)%state(4*ns+2*nt+2*nr+j, of)) + enddo; enddo + c = c + ns + case (resolved_stress_shearband_ID) + do j = 1_pInt,6_pInt ! loop over all shearband families + plastic_dislotwin_postResults(c+j) = dot_product(Tstar_v, & + plastic_dislotwin_sbSv(1:6,j,ipc,ip,el)) + enddo + c = c + 6_pInt + case (shear_rate_shearband_ID) + do j = 1_pInt,6_pInt ! loop over all shearbands + !* Resolved shear stress on shearband system + tau = dot_product(Tstar_v,plastic_dislotwin_sbSv(1:6,j,ipc,ip,el)) + !* Stress ratios + if (abs(tau) < tol_math_check) then + StressRatio_p = 0.0_pReal + StressRatio_pminus1 = 0.0_pReal + else + StressRatio_p = (abs(tau)/plastic_dislotwin_sbResistance(instance))**& + plastic_dislotwin_pShearBand(instance) + StressRatio_pminus1 = (abs(tau)/plastic_dislotwin_sbResistance(instance))**& + (plastic_dislotwin_pShearBand(instance)-1.0_pReal) + endif + !* Boltzmann ratio + BoltzmannRatio = plastic_dislotwin_sbQedge(instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = plastic_dislotwin_sbVelocity(instance) + ! Shear rate due to shear band + plastic_dislotwin_postResults(c+j) = & + DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**plastic_dislotwin_qShearBand(instance))*& + sign(1.0_pReal,tau) + enddo + c = c + 6_pInt + case (twin_fraction_ID) + plastic_dislotwin_postResults(c+1_pInt:c+nt) = state(instance)%twinFraction(1_pInt:nt,of) + c = c + nt + case (shear_rate_twin_ID) + if (nt > 0_pInt) then + + j = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j + 1_pInt + + !* Resolved shear stress on slip system + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + !* Stress ratios + if((abs(tau)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratios + StressRatio_p = ((abs(tau)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_dislotwin_SolidSolutionStrength(instance)+& + plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& + **plastic_dislotwin_pPerSlipFamily(f,instance) + StressRatio_pminus1 = ((abs(tau)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_dislotwin_SolidSolutionStrength(instance)+& + plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& + **(plastic_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) + !* Boltzmann ratio + BoltzmannRatio = plastic_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(instance)%rhoEdge(j,of)*plastic_dislotwin_burgersPerSlipSystem(j,instance)* & + plastic_dislotwin_v0PerSlipSystem(j,instance) + + !* Shear rates due to slip + gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& + plastic_dislotwin_qPerSlipFamily(f,instance))*sign(1.0_pReal,tau) + else + gdot_slip(j) = 0.0_pReal + endif + 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,ph)) ! at which index starts my family + do i = 1,plastic_dislotwin_Ntwin(f,instance) ! process each (active) twin system in family + j = j + 1_pInt + + tau = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + + + !* Shear rates due to twin + if ( tau > 0.0_pReal ) then + select case(lattice_structure(ph)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau < plastic_dislotwin_tau_r_twin(j,instance)) then + Ndot0_twin=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& + (plastic_dislotwin_L0_twin(instance)*& + plastic_dislotwin_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-plastic_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& + (plastic_dislotwin_tau_r_twin(j,instance)-tau))) + else + Ndot0_twin=0.0_pReal + end if + case default + Ndot0_twin=plastic_dislotwin_Ndot0PerTwinSystem(j,instance) + end select + StressRatio_r = (state(instance)%threshold_stress_twin(j,of)/tau) & + **plastic_dislotwin_rPerTwinFamily(f,instance) + plastic_dislotwin_postResults(c+j) = & + (plastic_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& + state(instance)%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) + endif + + enddo ; enddo + endif + c = c + nt + case (accumulated_shear_twin_ID) + plastic_dislotwin_postResults(c+1_pInt:c+nt) = state(instance)%accshear_twin(1_pInt:nt,of) + c = c + nt + case (mfp_twin_ID) + plastic_dislotwin_postResults(c+1_pInt:c+nt) = state(instance)%mfp_twin(1_pInt:nt,of) + c = c + nt + case (resolved_stress_twin_ID) + if (nt > 0_pInt) then + j = 0_pInt + do f = 1_pInt,lattice_maxNtwinFamily ! loop over all slip families + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Ntwin(f,instance) ! process each (active) slip system in family + j = j + 1_pInt + plastic_dislotwin_postResults(c+j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + enddo; enddo + endif + c = c + nt + case (threshold_stress_twin_ID) + plastic_dislotwin_postResults(c+1_pInt:c+nt) = state(instance)%threshold_stress_twin(1_pInt:nt,of) + c = c + nt + case (stress_exponent_ID) + j = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j + 1_pInt + + !* Resolved shear stress on slip system + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + if((abs(tau)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + !* Stress ratios + StressRatio_p = ((abs(tau)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_dislotwin_SolidSolutionStrength(instance)+& + plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& + **plastic_dislotwin_pPerSlipFamily(f,instance) + StressRatio_pminus1 = ((abs(tau)-state(instance)%threshold_stress_slip(j,of))/& + (plastic_dislotwin_SolidSolutionStrength(instance)+& + plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance)))& + **(plastic_dislotwin_pPerSlipFamily(f,instance)-1.0_pReal) + !* Boltzmann ratio + BoltzmannRatio = plastic_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(instance)%rhoEdge(j,of)*plastic_dislotwin_burgersPerSlipSystem(j,instance)* & + plastic_dislotwin_v0PerSlipSystem(j,instance) + + !* Shear rates due to slip + gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& + plastic_dislotwin_qPerSlipFamily(f,instance))*sign(1.0_pReal,tau) + + !* Derivatives of shear rates + dgdot_dtauslip = & + abs(gdot_slip(j))*BoltzmannRatio*plastic_dislotwin_pPerSlipFamily(f,instance)& + *plastic_dislotwin_qPerSlipFamily(f,instance)/& + (plastic_dislotwin_SolidSolutionStrength(instance)+& + plastic_dislotwin_tau_peierlsPerSlipFamily(f,instance))*& + StressRatio_pminus1*(1-StressRatio_p)**(plastic_dislotwin_qPerSlipFamily(f,instance)-1.0_pReal) + + else + gdot_slip(j) = 0.0_pReal + dgdot_dtauslip = 0.0_pReal + endif + + !* Stress exponent + if (abs(gdot_slip(j))<=tiny(0.0_pReal)) then + plastic_dislotwin_postResults(c+j) = 0.0_pReal + else + plastic_dislotwin_postResults(c+j) = (tau/gdot_slip(j))*dgdot_dtauslip + endif + enddo ; enddo + c = c + ns + case (sb_eigenvalues_ID) + plastic_dislotwin_postResults(c+1_pInt:c+3_pInt) = math_eigenvaluesSym33(math_Mandel6to33(Tstar_v)) + c = c + 3_pInt + case (sb_eigenvectors_ID) + call math_spectralDecompositionSym33(math_Mandel6to33(Tstar_v),eigValues,eigVectors) + plastic_dislotwin_postResults(c+1_pInt:c+9_pInt) = reshape(eigVectors,[9]) + c = c + 9_pInt + case (stress_trans_fraction_ID) + plastic_dislotwin_postResults(c+1_pInt:c+nr) = & + state(instance)%stressTransFraction(1_pInt:nr,of) + c = c + nr + case (strain_trans_fraction_ID) + plastic_dislotwin_postResults(c+1_pInt:c+nr) = & + state(instance)%strainTransFraction(1_pInt:nr,of) + c = c + nr + case (trans_fraction_ID) + plastic_dislotwin_postResults(c+1_pInt:c+nr) = & + state(instance)%stressTransFraction(1_pInt:nr,of) + & + state(instance)%strainTransFraction(1_pInt:nr,of) + c = c + nr + end select + enddo +end function plastic_dislotwin_postResults + +end module plastic_dislotwin \ No newline at end of file diff --git a/code/plastic/plastic_isotropic.f90 b/code/plastic/plastic_isotropic.f90 new file mode 100644 index 000000000..13481b9a7 --- /dev/null +++ b/code/plastic/plastic_isotropic.f90 @@ -0,0 +1,678 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for isotropic (ISOTROPIC) plasticity +!> @details Isotropic (ISOTROPIC) Plasticity which resembles the phenopowerlaw plasticity without +!! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an +!! untextured polycrystal +!-------------------------------------------------------------------------------------------------- +module plastic_isotropic +#ifdef HDF + use hdf5, only: & + HID_T +#endif + + use prec, only: & + pReal,& + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_isotropic_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_isotropic_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_isotropic_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_isotropic_Noutput !< number of outputs per instance + + enum, bind(c) + enumerator :: undefined_ID, & + flowstress_ID, & + strainrate_ID + end enum + + type, private :: tParameters !< container type for internal constitutive parameters + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID + real(pReal) :: & + fTaylor, & + tau0, & + gdot0, & + n, & + h0, & + h0_slopeLnRate, & + tausat, & + a, & + aTolFlowstress, & + aTolShear , & + tausat_SinhFitA, & + tausat_SinhFitB, & + tausat_SinhFitC, & + tausat_SinhFitD + logical :: & + dilatation + end type + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + type, private :: tIsotropicState !< internal state aliases + real(pReal), pointer, dimension(:) :: & ! scalars along NipcMyInstance + flowstress, & + accumulatedShear + end type + type, private :: tIsotropicAbsTol !< internal alias for abs tolerance in state + real(pReal), pointer :: & ! scalars along NipcMyInstance + flowstress, & + accumulatedShear + end type + type(tIsotropicState), allocatable, dimension(:), private :: & !< state aliases per instance + state, & + state0, & + dotState + type(tIsotropicAbsTol), allocatable, dimension(:), private :: & !< state aliases per instance + stateAbsTol + + public :: & + plastic_isotropic_init, & + plastic_isotropic_LpAndItsTangent, & + plastic_isotropic_LiAndItsTangent, & + plastic_isotropic_dotState, & + plastic_isotropic_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_isotropic_init(fileUnit) + 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 numerics, only: & + analyticJaco, & + worldrank, & + numerics_integrator + use math, only: & + math_Mandel3333to66, & + math_Voigt66to3333 + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_ISOTROPIC_label, & + PLASTICITY_ISOTROPIC_ID, & + material_phase, & + plasticState, & + MATERIAL_partPhase + + use lattice + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + o, & + phase, & + instance, & + maxNinstance, & + mySize, & + sizeDotState, & + sizeState, & + sizeDeltaState + character(len=65536) :: & + tag = '', & + outputtag = '', & + line = '', & + extmsg = '' + integer(pInt) :: NipcMyPhase + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(plastic_isotropic_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt) + allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance)) + plastic_isotropic_output = '' + allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt) + + allocate(param(maxNinstance)) ! one container of parameters per instance + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next section + phase = phase + 1_pInt ! advance section counter + if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then + instance = phase_plasticityInstance(phase) + + endif + cycle ! skip to next line + endif + if (phase > 0_pInt) then; if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + allocate(param(instance)%outputID(phase_Noutput(phase))) ! allocate space for IDs of every requested output + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + extmsg = trim(tag)//' ('//PLASTICITY_ISOTROPIC_label//')' ! prepare error message identifier + + select case(tag) + case ('(output)') + outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + select case(outputtag) + case ('flowstress') + plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt + param(instance)%outputID (plastic_isotropic_Noutput(instance)) = flowstress_ID + plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag + case ('strainrate') + plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt + param(instance)%outputID (plastic_isotropic_Noutput(instance)) = strainrate_ID + plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag + + end select + + case ('/dilatation/') + param(instance)%dilatation = .true. + + case ('tau0') + param(instance)%tau0 = IO_floatValue(line,chunkPos,2_pInt) + if (param(instance)%tau0 < 0.0_pReal) call IO_error(211_pInt,ext_msg=extmsg) + + case ('gdot0') + param(instance)%gdot0 = IO_floatValue(line,chunkPos,2_pInt) + if (param(instance)%gdot0 <= 0.0_pReal) call IO_error(211_pInt,ext_msg=extmsg) + + case ('n') + param(instance)%n = IO_floatValue(line,chunkPos,2_pInt) + if (param(instance)%n <= 0.0_pReal) call IO_error(211_pInt,ext_msg=extmsg) + + case ('h0') + param(instance)%h0 = IO_floatValue(line,chunkPos,2_pInt) + + case ('h0_slope','slopelnrate') + param(instance)%h0_slopeLnRate = IO_floatValue(line,chunkPos,2_pInt) + + case ('tausat') + param(instance)%tausat = IO_floatValue(line,chunkPos,2_pInt) + if (param(instance)%tausat <= 0.0_pReal) call IO_error(211_pInt,ext_msg=extmsg) + + case ('tausat_sinhfita') + param(instance)%tausat_SinhFitA = IO_floatValue(line,chunkPos,2_pInt) + + case ('tausat_sinhfitb') + param(instance)%tausat_SinhFitB = IO_floatValue(line,chunkPos,2_pInt) + + case ('tausat_sinhfitc') + param(instance)%tausat_SinhFitC = IO_floatValue(line,chunkPos,2_pInt) + + case ('tausat_sinhfitd') + param(instance)%tausat_SinhFitD = IO_floatValue(line,chunkPos,2_pInt) + + case ('a', 'w0') + param(instance)%a = IO_floatValue(line,chunkPos,2_pInt) + if (param(instance)%a <= 0.0_pReal) call IO_error(211_pInt,ext_msg=extmsg) + + case ('taylorfactor') + param(instance)%fTaylor = IO_floatValue(line,chunkPos,2_pInt) + if (param(instance)%fTaylor <= 0.0_pReal) call IO_error(211_pInt,ext_msg=extmsg) + + case ('atol_flowstress') + param(instance)%aTolFlowstress = IO_floatValue(line,chunkPos,2_pInt) + if (param(instance)%aTolFlowstress <= 0.0_pReal) call IO_error(211_pInt,ext_msg=extmsg) + + case ('atol_shear') + param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) + + case default + + end select + endif; endif + enddo parsingFile + + allocate(state(maxNinstance)) ! internal state aliases + allocate(state0(maxNinstance)) + allocate(dotState(maxNinstance)) + allocate(stateAbsTol(maxNinstance)) + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop over every plasticity + myPhase: if (phase_plasticity(phase) == PLASTICITY_isotropic_ID) then ! isolate instances of own constitutive description + NipcMyPhase = count(material_phase == phase) ! number of own material points (including point components ipc) + instance = phase_plasticityInstance(phase) +!-------------------------------------------------------------------------------------------------- +! sanity checks + if (param(instance)%aTolShear <= 0.0_pReal) & + param(instance)%aTolShear = 1.0e-6_pReal ! default absolute tolerance 1e-6 + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance) + select case(param(instance)%outputID(o)) + case(flowstress_ID,strainrate_ID) + mySize = 1_pInt + case default + end select + + outputFound: if (mySize > 0_pInt) then + plastic_isotropic_sizePostResult(o,instance) = mySize + plastic_isotropic_sizePostResults(instance) = & + plastic_isotropic_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop + +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + sizeState = 2_pInt ! flowstress, accumulated_shear + sizeDotState = sizeState ! both evolve + sizeDeltaState = 0_pInt ! no sudden jumps in state + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_isotropic_sizePostResults(instance) + plasticState(phase)%nSlip = 1 + plasticState(phase)%nTwin = 0 + plasticState(phase)%nTrans= 0 + allocate(plasticState(phase)%aTolState ( sizeState)) + + allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase),source=0.0_pReal) + + allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%state ( sizeState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase),source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup ( sizeState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase),source=0.0_pReal) + +!-------------------------------------------------------------------------------------------------- +! globally required state aliases + plasticState(phase)%slipRate => plasticState(phase)%dotState(2:2,1:NipcMyPhase) + plasticState(phase)%accumulatedSlip => plasticState(phase)%state (2:2,1:NipcMyPhase) + +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases + state(instance)%flowstress => plasticState(phase)%state (1,1:NipcMyPhase) + state0(instance)%flowstress => plasticState(phase)%state0 (1,1:NipcMyPhase) + dotState(instance)%flowstress => plasticState(phase)%dotState (1,1:NipcMyPhase) + stateAbsTol(instance)%flowstress => plasticState(phase)%aTolState(1) + + state(instance)%accumulatedShear => plasticState(phase)%state (2,1:NipcMyPhase) + state0(instance)%accumulatedShear => plasticState(phase)%state0 (2,1:NipcMyPhase) + dotState(instance)%accumulatedShear => plasticState(phase)%dotState (2,1:NipcMyPhase) + stateAbsTol(instance)%accumulatedShear => plasticState(phase)%aTolState(2) + +!-------------------------------------------------------------------------------------------------- +! init state + state0(instance)%flowstress = param(instance)%tau0 + state0(instance)%accumulatedShear = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! init absolute state tolerances + stateAbsTol(instance)%flowstress = param(instance)%aTolFlowstress + stateAbsTol(instance)%accumulatedShear = param(instance)%aTolShear + + endif myPhase + enddo initializeInstances + +end subroutine plastic_isotropic_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelBasic, & + debug_levelExtensive, & + debug_levelSelective, & + debug_e, & + debug_i, & + debug_g + use math, only: & + math_mul6x6, & + math_Mandel6to33, & + math_Plain3333to99, & + math_deviatoric33, & + math_mul33xx33, & + math_transpose33 + use material, only: & + phaseAt, phasememberAt, & + plasticState, & + material_phase, & + phase_plasticityInstance + + implicit none + 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 + + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + + real(pReal), dimension(3,3) :: & + Tstar_dev_33 !< deviatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor + real(pReal), dimension(3,3,3,3) :: & + dLp_dTstar_3333 !< derivative of Lp with respect to Tstar as 4th order tensor + real(pReal) :: & + gamma_dot, & !< strainrate + norm_Tstar_dev, & !< euclidean norm of Tstar_dev + squarenorm_Tstar_dev !< square of the euclidean norm of Tstar_dev + integer(pInt) :: & + instance, of, & + k, l, m, n + + of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember + instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ! "phaseAt" equivalent to "material_phase" !! + + Tstar_dev_33 = math_deviatoric33(math_Mandel6to33(Tstar_v)) ! deviatoric part of 2nd Piola-Kirchhoff stress + squarenorm_Tstar_dev = math_mul33xx33(Tstar_dev_33,Tstar_dev_33) + norm_Tstar_dev = sqrt(squarenorm_Tstar_dev) + + if (norm_Tstar_dev <= 0.0_pReal) then ! Tstar == 0 --> both Lp and dLp_dTstar are zero + Lp = 0.0_pReal + dLp_dTstar99 = 0.0_pReal + else + gamma_dot = param(instance)%gdot0 & + * ( sqrt(1.5_pReal) * norm_Tstar_dev / param(instance)%fTaylor / state(instance)%flowstress(of) ) & + **param(instance)%n + + Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/param(instance)%fTaylor + + if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & + .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + write(6,'(a,i8,1x,i2,1x,i3)') '<< CONST isotropic >> at el ip g ',el,ip,ipc + write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', & + math_transpose33(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal + write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Tstar_dev*1.0e-6_pReal + write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', gamma_dot + end if +!-------------------------------------------------------------------------------------------------- +! 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_dTstar_3333(k,l,m,n) = (param(instance)%n-1.0_pReal) * & + Tstar_dev_33(k,l)*Tstar_dev_33(m,n) / squarenorm_Tstar_dev + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) & + dLp_dTstar_3333(k,l,k,l) = dLp_dTstar_3333(k,l,k,l) + 1.0_pReal + forall (k=1_pInt:3_pInt,m=1_pInt:3_pInt) & + dLp_dTstar_3333(k,k,m,m) = dLp_dTstar_3333(k,k,m,m) - 1.0_pReal/3.0_pReal + dLp_dTstar99 = math_Plain3333to99(gamma_dot / param(instance)%fTaylor * & + dLp_dTstar_3333 / norm_Tstar_dev) + end if +end subroutine plastic_isotropic_LpAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar_3333,Tstar_v,ipc,ip,el) + use math, only: & + math_mul6x6, & + math_Mandel6to33, & + math_Plain3333to99, & + math_spherical33, & + math_mul33xx33 + use material, only: & + phaseAt, phasememberAt, & + plasticState, & + material_phase, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(3,3), intent(out) :: & + Li !< plastic velocity gradient + + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + + real(pReal), dimension(3,3) :: & + Tstar_sph_33 !< sphiatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLi_dTstar_3333 !< derivative of Li with respect to Tstar as 4th order tensor + real(pReal) :: & + gamma_dot, & !< strainrate + norm_Tstar_sph, & !< euclidean norm of Tstar_sph + squarenorm_Tstar_sph !< square of the euclidean norm of Tstar_sph + integer(pInt) :: & + instance, of, & + k, l, m, n + + of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember + instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ! "phaseAt" equivalent to "material_phase" !! + + Tstar_sph_33 = math_spherical33(math_Mandel6to33(Tstar_v)) ! spherical part of 2nd Piola-Kirchhoff stress + squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph_33,Tstar_sph_33) + norm_Tstar_sph = sqrt(squarenorm_Tstar_sph) + + if (param(instance)%dilatation) then + if (norm_Tstar_sph <= 0.0_pReal) then ! Tstar == 0 --> both Li and dLi_dTstar are zero + Li = 0.0_pReal + dLi_dTstar_3333 = 0.0_pReal + else + gamma_dot = param(instance)%gdot0 & + * (sqrt(1.5_pReal) * norm_Tstar_sph / param(instance)%fTaylor / state(instance)%flowstress(of) ) & + **param(instance)%n + + Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/param(instance)%fTaylor + + !-------------------------------------------------------------------------------------------------- + ! Calculation of the tangent of Li + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLi_dTstar_3333(k,l,m,n) = (param(instance)%n-1.0_pReal) * & + Tstar_sph_33(k,l)*Tstar_sph_33(m,n) / squarenorm_Tstar_sph + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) & + dLi_dTstar_3333(k,l,k,l) = dLi_dTstar_3333(k,l,k,l) + 1.0_pReal + + dLi_dTstar_3333 = gamma_dot / param(instance)%fTaylor * & + dLi_dTstar_3333 / norm_Tstar_sph + endif + endif + +end subroutine plastic_isotropic_LiAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el) + use math, only: & + math_mul6x6 + use material, only: & + phaseAt, phasememberAt, & + plasticState, & + material_phase, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in):: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(6) :: & + Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal) :: & + gamma_dot, & !< strainrate + hardening, & !< hardening coefficient + saturation, & !< saturation flowstress + norm_Tstar_v !< euclidean norm of Tstar_dev + integer(pInt) :: & + instance, & !< instance of my instance (unique number of my constitutive model) + of !< shortcut notation for offset position in state array + + of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember + instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ! "phaseAt" equivalent to "material_phase" !! + +!-------------------------------------------------------------------------------------------------- +! norm of (deviatoric) 2nd Piola-Kirchhoff stress + if (param(instance)%dilatation) then + norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v)) + else + Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal + Tstar_dev_v(4:6) = Tstar_v(4:6) + norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v)) + end if +!-------------------------------------------------------------------------------------------------- +! strain rate + gamma_dot = param(instance)%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & + / &!----------------------------------------------------------------------------------- + (param(instance)%fTaylor*state(instance)%flowstress(of) ))**param(instance)%n + +!-------------------------------------------------------------------------------------------------- +! hardening coefficient + if (abs(gamma_dot) > 1e-12_pReal) then + if (abs(param(instance)%tausat_SinhFitA) <= tiny(0.0_pReal)) then + saturation = param(instance)%tausat + else + saturation = ( param(instance)%tausat & + + ( log( ( gamma_dot / param(instance)%tausat_SinhFitA& + )**(1.0_pReal / param(instance)%tausat_SinhFitD)& + + sqrt( ( gamma_dot / param(instance)%tausat_SinhFitA & + )**(2.0_pReal / param(instance)%tausat_SinhFitD) & + + 1.0_pReal ) & + ) & ! asinh(K) = ln(K + sqrt(K^2 +1)) + )**(1.0_pReal / param(instance)%tausat_SinhFitC) & + / ( param(instance)%tausat_SinhFitB & + * (gamma_dot / param(instance)%gdot0)**(1.0_pReal / param(instance)%n) & + ) & + ) + endif + hardening = ( param(instance)%h0 + param(instance)%h0_slopeLnRate * log(gamma_dot) ) & + * abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**param(instance)%a & + * sign(1.0_pReal, 1.0_pReal - state(instance)%flowstress(of)/saturation) + else + hardening = 0.0_pReal + endif + + dotState(instance)%flowstress (of) = hardening * gamma_dot + dotState(instance)%accumulatedShear(of) = gamma_dot + +end subroutine plastic_isotropic_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_isotropic_postResults(Tstar_v,ipc,ip,el) + use math, only: & + math_mul6x6 + use material, only: & + material_phase, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(plastic_isotropic_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_isotropic_postResults + + real(pReal), dimension(6) :: & + Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal) :: & + norm_Tstar_v ! euclidean norm of Tstar_dev + integer(pInt) :: & + instance, & !< instance of my instance (unique number of my constitutive model) + of, & !< shortcut notation for offset position in state array + c, & + o + + of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember + instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ! "phaseAt" equivalent to "material_phase" !! + +!-------------------------------------------------------------------------------------------------- +! norm of (deviatoric) 2nd Piola-Kirchhoff stress + if (param(instance)%dilatation) then + norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v)) + else + Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal + Tstar_dev_v(4:6) = Tstar_v(4:6) + norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v)) + end if + + c = 0_pInt + plastic_isotropic_postResults = 0.0_pReal + + outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance) + select case(param(instance)%outputID(o)) + case (flowstress_ID) + plastic_isotropic_postResults(c+1_pInt) = state(instance)%flowstress(of) + c = c + 1_pInt + case (strainrate_ID) + plastic_isotropic_postResults(c+1_pInt) = & + param(instance)%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & + / &!---------------------------------------------------------------------------------- + (param(instance)%fTaylor * state(instance)%flowstress(of)) ) ** param(instance)%n + c = c + 1_pInt + end select + enddo outputsLoop + +end function plastic_isotropic_postResults + + +end module plastic_isotropic diff --git a/code/plastic/plastic_j2.f90 b/code/plastic/plastic_j2.f90 new file mode 100644 index 000000000..89c022cc9 --- /dev/null +++ b/code/plastic/plastic_j2.f90 @@ -0,0 +1,579 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for isotropic (J2) plasticity +!> @details Isotropic (J2) Plasticity which resembles the phenopowerlaw plasticity without +!! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an +!! untextured polycrystal +!-------------------------------------------------------------------------------------------------- +module plastic_j2 +#ifdef HDF + use hdf5, only: & + HID_T +#endif + + use prec, only: & + pReal,& + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_j2_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_j2_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_j2_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_j2_Noutput !< number of outputs per instance + real(pReal), dimension(:), allocatable, private :: & + plastic_j2_fTaylor, & !< Taylor factor + plastic_j2_tau0, & !< initial plastic stress + plastic_j2_gdot0, & !< reference velocity + plastic_j2_n, & !< Visco-plastic parameter +!-------------------------------------------------------------------------------------------------- +! h0 as function of h0 = A + B log (gammadot) + plastic_j2_h0, & + plastic_j2_h0_slopeLnRate, & + plastic_j2_tausat, & !< final plastic stress + plastic_j2_a, & + plastic_j2_aTolResistance, & + plastic_j2_aTolShear, & +!-------------------------------------------------------------------------------------------------- +! tausat += (asinh((gammadot / SinhFitA)**(1 / SinhFitD)))**(1 / SinhFitC) / (SinhFitB * (gammadot / gammadot0)**(1/n)) + plastic_j2_tausat_SinhFitA, & !< fitting parameter for normalized strain rate vs. stress function + plastic_j2_tausat_SinhFitB, & !< fitting parameter for normalized strain rate vs. stress function + plastic_j2_tausat_SinhFitC, & !< fitting parameter for normalized strain rate vs. stress function + plastic_j2_tausat_SinhFitD !< fitting parameter for normalized strain rate vs. stress function + + enum, bind(c) + enumerator :: undefined_ID, & + flowstress_ID, & + strainrate_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_j2_outputID !< ID of each post result output + + +#ifdef HDF + type plastic_j2_tOutput + real(pReal), dimension(:), allocatable, private :: & + flowstress, & + strainrate + logical :: flowstressActive = .false., strainrateActive = .false. ! if we can write the output block wise, this is not needed anymore because we can do an if(allocated(xxx)) + end type plastic_j2_tOutput + type(plastic_j2_tOutput), allocatable, dimension(:) :: plastic_j2_Output2 +integer(HID_T), allocatable, dimension(:) :: outID +#endif + + + public :: & + plastic_j2_init, & + plastic_j2_LpAndItsTangent, & + plastic_j2_dotState, & + plastic_j2_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_j2_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +#ifdef HDF + use hdf5 +#endif + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelBasic + use numerics, only: & + analyticJaco, & + worldrank, & + numerics_integrator + use math, only: & + math_Mandel3333to66, & + math_Voigt66to3333 + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_error, & + IO_timeStamp, & +#ifdef HDF + tempResults, & + HDF5_addGroup, & + HDF5_addScalarDataset,& +#endif + IO_EOF + use material, only: & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_J2_label, & + PLASTICITY_J2_ID, & + material_phase, & + plasticState, & + MATERIAL_partPhase + + use lattice + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + o, & + phase, & + maxNinstance, & + instance, & + mySize, & + sizeDotState, & + sizeState, & + sizeDeltaState + character(len=65536) :: & + tag = '', & + line = '' + integer(pInt) :: NofMyPhase + +#ifdef HDF + character(len=5) :: & + str1 + integer(HID_T) :: ID,ID2,ID4 +#endif + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_J2_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_J2_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + +#ifdef HDF + allocate(plastic_j2_Output2(maxNinstance)) + allocate(outID(maxNinstance)) +#endif + + allocate(plastic_j2_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_j2_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt) + allocate(plastic_j2_output(maxval(phase_Noutput), maxNinstance)) + plastic_j2_output = '' + allocate(plastic_j2_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(plastic_j2_Noutput(maxNinstance), source=0_pInt) + allocate(plastic_j2_fTaylor(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_tau0(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_gdot0(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_n(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_h0(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_h0_slopeLnRate(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_tausat(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_a(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_aTolResistance(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_aTolShear (maxNinstance), source=0.0_pReal) + allocate(plastic_j2_tausat_SinhFitA(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_tausat_SinhFitB(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_tausat_SinhFitC(maxNinstance), source=0.0_pReal) + allocate(plastic_j2_tausat_SinhFitD(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next section + phase = phase + 1_pInt ! advance section counter + if (phase_plasticity(phase) == PLASTICITY_J2_ID) then + instance = phase_plasticityInstance(phase) +#ifdef HDF + outID(instance)=HDF5_addGroup(str1,tempResults) +#endif + endif + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_J2_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('flowstress') + plastic_j2_Noutput(instance) = plastic_j2_Noutput(instance) + 1_pInt + plastic_j2_outputID(plastic_j2_Noutput(instance),instance) = flowstress_ID + plastic_j2_output(plastic_j2_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) +#ifdef HDF + call HDF5_addScalarDataset(outID(instance),myConstituents,'flowstress','MPa') + allocate(plastic_j2_Output2(instance)%flowstress(myConstituents)) + plastic_j2_Output2(instance)%flowstressActive = .true. +#endif + case ('strainrate') + plastic_j2_Noutput(instance) = plastic_j2_Noutput(instance) + 1_pInt + plastic_j2_outputID(plastic_j2_Noutput(instance),instance) = strainrate_ID + plastic_j2_output(plastic_j2_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) +#ifdef HDF + call HDF5_addScalarDataset(outID(instance),myConstituents,'strainrate','1/s') + allocate(plastic_j2_Output2(instance)%strainrate(myConstituents)) + plastic_j2_Output2(instance)%strainrateActive = .true. +#endif + case default + + end select + case ('tau0') + plastic_j2_tau0(instance) = IO_floatValue(line,chunkPos,2_pInt) + if (plastic_j2_tau0(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('gdot0') + plastic_j2_gdot0(instance) = IO_floatValue(line,chunkPos,2_pInt) + if (plastic_j2_gdot0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('n') + plastic_j2_n(instance) = IO_floatValue(line,chunkPos,2_pInt) + if (plastic_j2_n(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('h0') + plastic_j2_h0(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('h0_slope','slopelnrate') + plastic_j2_h0_slopeLnRate(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('tausat') + plastic_j2_tausat(instance) = IO_floatValue(line,chunkPos,2_pInt) + if (plastic_j2_tausat(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('tausat_sinhfita') + plastic_j2_tausat_SinhFitA(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('tausat_sinhfitb') + plastic_j2_tausat_SinhFitB(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('tausat_sinhfitc') + plastic_j2_tausat_SinhFitC(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('tausat_sinhfitd') + plastic_j2_tausat_SinhFitD(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('a', 'w0') + plastic_j2_a(instance) = IO_floatValue(line,chunkPos,2_pInt) + if (plastic_j2_a(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('taylorfactor') + plastic_j2_fTaylor(instance) = IO_floatValue(line,chunkPos,2_pInt) + if (plastic_j2_fTaylor(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('atol_resistance') + plastic_j2_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + if (plastic_j2_aTolResistance(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('atol_shear') + plastic_j2_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case default + + end select + endif; endif + enddo parsingFile + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_j2_ID) then + NofMyPhase=count(material_phase==phase) + instance = phase_plasticityInstance(phase) +!-------------------------------------------------------------------------------------------------- +! sanity checks + if (plastic_j2_aTolShear(instance) <= 0.0_pReal) & + plastic_j2_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,plastic_j2_Noutput(instance) + select case(plastic_j2_outputID(o,instance)) + case(flowstress_ID,strainrate_ID) + mySize = 1_pInt + case default + end select + + outputFound: if (mySize > 0_pInt) then + plastic_j2_sizePostResult(o,instance) = mySize + plastic_j2_sizePostResults(instance) = & + plastic_j2_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop + +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + sizeState = 2_pInt + sizeDotState = sizeState + sizeDeltaState = 0_pInt + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_j2_sizePostResults(instance) + plasticState(phase)%nSlip = 1 + plasticState(phase)%nTwin = 0 + plasticState(phase)%nTrans= 0 + allocate(plasticState(phase)%aTolState ( sizeState)) + plasticState(phase)%aTolState(1) = plastic_j2_aTolResistance(instance) + plasticState(phase)%aTolState(2) = plastic_j2_aTolShear(instance) + allocate(plasticState(phase)%state0 ( sizeState,NofMyPhase)) + plasticState(phase)%state0(1,1:NofMyPhase) = plastic_j2_tau0(instance) + plasticState(phase)%state0(2,1:NofMyPhase) = 0.0_pReal + allocate(plasticState(phase)%partionedState0 ( sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%subState0 ( sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%state ( sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase),source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup ( sizeState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase),source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + plasticState(phase)%slipRate => plasticState(phase)%dotState(2:2,1:NofMyPhase) + plasticState(phase)%accumulatedSlip => plasticState(phase)%state (2:2,1:NofMyPhase) + endif myPhase + enddo initializeInstances + +end subroutine plastic_j2_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) + use math, only: & + math_mul6x6, & + math_Mandel6to33, & + math_Plain3333to99, & + math_deviatoric33, & + math_mul33xx33 + use material, only: & + phaseAt, phasememberAt, & + plasticState, & + material_phase, & + phase_plasticityInstance + + implicit none + 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 + + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + + real(pReal), dimension(3,3) :: & + Tstar_dev_33 !< deviatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor + real(pReal), dimension(3,3,3,3) :: & + dLp_dTstar_3333 !< derivative of Lp with respect to Tstar as 4th order tensor + real(pReal) :: & + gamma_dot, & !< strainrate + norm_Tstar_dev, & !< euclidean norm of Tstar_dev + squarenorm_Tstar_dev !< square of the euclidean norm of Tstar_dev + integer(pInt) :: & + instance, & + k, l, m, n + + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + Tstar_dev_33 = math_deviatoric33(math_Mandel6to33(Tstar_v)) ! deviatoric part of 2nd Piola-Kirchhoff stress + squarenorm_Tstar_dev = math_mul33xx33(Tstar_dev_33,Tstar_dev_33) + norm_Tstar_dev = sqrt(squarenorm_Tstar_dev) + + if (norm_Tstar_dev <= 0.0_pReal) then ! Tstar == 0 --> both Lp and dLp_dTstar are zero + Lp = 0.0_pReal + dLp_dTstar99 = 0.0_pReal + else + gamma_dot = plastic_j2_gdot0(instance) & + * (sqrt(1.5_pReal) * norm_Tstar_dev / (plastic_j2_fTaylor(instance) * & + plasticState(phaseAt(ipc,ip,el))%state(1,phasememberAt(ipc,ip,el)))) & + **plastic_j2_n(instance) + + Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/plastic_j2_fTaylor(instance) + +!-------------------------------------------------------------------------------------------------- +! 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_dTstar_3333(k,l,m,n) = (plastic_j2_n(instance)-1.0_pReal) * & + Tstar_dev_33(k,l)*Tstar_dev_33(m,n) / squarenorm_Tstar_dev + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) & + dLp_dTstar_3333(k,l,k,l) = dLp_dTstar_3333(k,l,k,l) + 1.0_pReal + forall (k=1_pInt:3_pInt,m=1_pInt:3_pInt) & + dLp_dTstar_3333(k,k,m,m) = dLp_dTstar_3333(k,k,m,m) - 1.0_pReal/3.0_pReal + dLp_dTstar99 = math_Plain3333to99(gamma_dot / plastic_j2_fTaylor(instance) * & + dLp_dTstar_3333 / norm_Tstar_dev) + end if +end subroutine plastic_j2_LpAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_j2_dotState(Tstar_v,ipc,ip,el) + use math, only: & + math_mul6x6 + use material, only: & + phaseAt, phasememberAt, & + plasticState, & + material_phase, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in):: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(6) :: & + Tstar_dev_v !< deviatoric part of the 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal) :: & + gamma_dot, & !< strainrate + hardening, & !< hardening coefficient + saturation, & !< saturation resistance + norm_Tstar_dev !< euclidean norm of Tstar_dev + integer(pInt) :: & + instance, & !< instance of my instance (unique number of my constitutive model) + of, & !< shortcut notation for offset position in state array + ph !< shortcut notation for phase ID (unique number of all phases, regardless of constitutive model) + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + +!-------------------------------------------------------------------------------------------------- +! norm of deviatoric part of 2nd Piola-Kirchhoff stress + Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal + Tstar_dev_v(4:6) = Tstar_v(4:6) + norm_Tstar_dev = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v)) + +!-------------------------------------------------------------------------------------------------- +! strain rate + gamma_dot = plastic_j2_gdot0(instance) * ( sqrt(1.5_pReal) * norm_Tstar_dev & + / &!----------------------------------------------------------------------------------- + (plastic_j2_fTaylor(instance)*plasticState(ph)%state(1,of)) )**plastic_j2_n(instance) + +!-------------------------------------------------------------------------------------------------- +! hardening coefficient + if (abs(gamma_dot) > 1e-12_pReal) then + if (abs(plastic_j2_tausat_SinhFitA(instance)) <= tiny(0.0_pReal)) then + saturation = plastic_j2_tausat(instance) + else + saturation = ( plastic_j2_tausat(instance) & + + ( log( ( gamma_dot / plastic_j2_tausat_SinhFitA(instance)& + )**(1.0_pReal / plastic_j2_tausat_SinhFitD(instance))& + + sqrt( ( gamma_dot / plastic_j2_tausat_SinhFitA(instance) & + )**(2.0_pReal / plastic_j2_tausat_SinhFitD(instance)) & + + 1.0_pReal ) & + ) & ! asinh(K) = ln(K + sqrt(K^2 +1)) + )**(1.0_pReal / plastic_j2_tausat_SinhFitC(instance)) & + / ( plastic_j2_tausat_SinhFitB(instance) & + * (gamma_dot / plastic_j2_gdot0(instance))**(1.0_pReal / plastic_j2_n(instance)) & + ) & + ) + endif + hardening = ( plastic_j2_h0(instance) + plastic_j2_h0_slopeLnRate(instance) * log(gamma_dot) ) & + * abs( 1.0_pReal - plasticState(ph)%state(1,of)/saturation )**plastic_j2_a(instance) & + * sign(1.0_pReal, 1.0_pReal - plasticState(ph)%state(1,of)/saturation) + else + hardening = 0.0_pReal + endif + + plasticState(ph)%dotState(1,of) = hardening * gamma_dot + plasticState(ph)%dotState(2,of) = gamma_dot + +end subroutine plastic_j2_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_j2_postResults(Tstar_v,ipc,ip,el) + use math, only: & + math_mul6x6 + use material, only: & + material_phase, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(plastic_j2_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_j2_postResults + + real(pReal), dimension(6) :: & + Tstar_dev_v ! deviatoric part of the 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal) :: & + norm_Tstar_dev ! euclidean norm of Tstar_dev + integer(pInt) :: & + instance, & !< instance of my instance (unique number of my constitutive model) + of, & !< shortcut notation for offset position in state array + ph, & !< shortcut notation for phase ID (unique number of all phases, regardless of constitutive model) + c, & + o + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + +!-------------------------------------------------------------------------------------------------- +! calculate deviatoric part of 2nd Piola-Kirchhoff stress and its norm + Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal + Tstar_dev_v(4:6) = Tstar_v(4:6) + norm_Tstar_dev = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v)) + + c = 0_pInt + plastic_j2_postResults = 0.0_pReal + + outputsLoop: do o = 1_pInt,plastic_j2_Noutput(instance) + select case(plastic_j2_outputID(o,instance)) + case (flowstress_ID) + plastic_j2_postResults(c+1_pInt) = plasticState(ph)%state(1,of) + c = c + 1_pInt + case (strainrate_ID) + plastic_j2_postResults(c+1_pInt) = & + plastic_j2_gdot0(instance) * ( sqrt(1.5_pReal) * norm_Tstar_dev & + / &!---------------------------------------------------------------------------------- + (plastic_j2_fTaylor(instance) * plasticState(ph)%state(1,of)) ) ** plastic_j2_n(instance) + c = c + 1_pInt + end select + enddo outputsLoop + +end function plastic_j2_postResults + + +end module plastic_j2 diff --git a/code/plastic/plastic_none.f90 b/code/plastic/plastic_none.f90 new file mode 100644 index 000000000..f624a80a2 --- /dev/null +++ b/code/plastic/plastic_none.f90 @@ -0,0 +1,109 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for purely elastic material +!-------------------------------------------------------------------------------------------------- +module plastic_none + use prec, only: & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_none_sizePostResults + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_none_sizePostResult !< size of each post result output + + public :: & + plastic_none_init + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_none_init + 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 IO, only: & + IO_timeStamp + use numerics, only: & + worldrank, & + numerics_integrator + use material, only: & + phase_plasticity, & + PLASTICITY_NONE_label, & + material_phase, & + plasticState, & + PLASTICITY_none_ID + + implicit none + + integer(pInt) :: & + maxNinstance, & + phase, & + NofMyPhase, & + sizeState, & + sizeDotState, & + sizeDeltaState + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + if (phase_plasticity(phase) == PLASTICITY_none_ID) then + NofMyPhase=count(material_phase==phase) + + sizeState = 0_pInt + plasticState(phase)%sizeState = sizeState + sizeDotState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + sizeDeltaState = 0_pInt + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = 0_pInt + plasticState(phase)%nSlip = 0_pInt + plasticState(phase)%nTwin = 0_pInt + plasticState(phase)%nTrans = 0_pInt + allocate(plasticState(phase)%aTolState (sizeState)) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase)) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase)) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase)) + allocate(plasticState(phase)%state (sizeState,NofMyPhase)) + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase)) + + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase)) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase)) + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase)) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase)) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) + endif + enddo initializeInstances + + allocate(plastic_none_sizePostResults(maxNinstance), source=0_pInt) + +end subroutine plastic_none_init + +end module plastic_none diff --git a/code/plastic/plastic_nonlocal.f90 b/code/plastic/plastic_nonlocal.f90 new file mode 100644 index 000000000..1922c08e2 --- /dev/null +++ b/code/plastic/plastic_nonlocal.f90 @@ -0,0 +1,4031 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for plasticity including dislocation flux +!-------------------------------------------------------------------------------------------------- +module plastic_nonlocal + use prec, only: & + pReal, & + pInt + + implicit none + private + character(len=22), dimension(11), parameter, private :: & + BASICSTATES = ['rhoSglEdgePosMobile ', & + 'rhoSglEdgeNegMobile ', & + 'rhoSglScrewPosMobile ', & + 'rhoSglScrewNegMobile ', & + 'rhoSglEdgePosImmobile ', & + 'rhoSglEdgeNegImmobile ', & + 'rhoSglScrewPosImmobile', & + 'rhoSglScrewNegImmobile', & + 'rhoDipEdge ', & + 'rhoDipScrew ', & + 'accumulatedshear ' ] !< list of "basic" microstructural state variables that are independent from other state variables + + character(len=16), dimension(3), parameter, private :: & + DEPENDENTSTATES = ['rhoForest ', & + 'tauThreshold ', & + 'tauBack ' ] !< list of microstructural state variables that depend on other state variables + + character(len=20), dimension(6), parameter, private :: & + OTHERSTATES = ['velocityEdgePos ', & + 'velocityEdgeNeg ', & + 'velocityScrewPos ', & + 'velocityScrewNeg ', & + 'maxDipoleHeightEdge ', & + 'maxDipoleHeightScrew' ] !< list of other dependent state variables that are not updated by microstructure + + real(pReal), parameter, private :: & + KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin + + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_nonlocal_sizeDotState, & !< number of dotStates = number of basic state variables + plastic_nonlocal_sizeDependentState, & !< number of dependent state variables + plastic_nonlocal_sizeState, & !< total number of state variables + plastic_nonlocal_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_nonlocal_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_nonlocal_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_nonlocal_Noutput !< number of outputs per instance of this plasticity + + integer(pInt), dimension(:,:), allocatable, private :: & + iGamma, & !< state indices for accumulated shear + iRhoF, & !< state indices for forest density + iTauF, & !< state indices for critical resolved shear stress + iTauB !< state indices for backstress + integer(pInt), dimension(:,:,:), allocatable, private :: & + iRhoU, & !< state indices for unblocked density + iRhoB, & !< state indices for blocked density + iRhoD, & !< state indices for dipole density + iV, & !< state indices for dislcation velocities + iD !< state indices for stable dipole height + + integer(pInt), dimension(:), allocatable, public, protected :: & + totalNslip !< total number of active slip systems for each instance + + integer(pInt), dimension(:,:), allocatable, private :: & + Nslip, & !< number of active slip systems for each family and instance + slipFamily, & !< lookup table relating active slip system to slip family for each instance + slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance + colinearSystem !< colinear system to the active slip system (only valid for fcc!) + + real(pReal), dimension(:), allocatable, private :: & + atomicVolume, & !< atomic volume + Dsd0, & !< prefactor for self-diffusion coefficient + selfDiffusionEnergy, & !< activation enthalpy for diffusion + aTolRho, & !< absolute tolerance for dislocation density in state integration + aTolShear, & !< absolute tolerance for accumulated shear in state integration + significantRho, & !< density considered significant + significantN, & !< number of dislocations considered significant + cutoffRadius, & !< cutoff radius for dislocation stress + doublekinkwidth, & !< width of a doubkle kink in multiples of the burgers vector length b + solidSolutionEnergy, & !< activation energy for solid solution in J + solidSolutionSize, & !< solid solution obstacle size in multiples of the burgers vector length + solidSolutionConcentration, & !< concentration of solid solution in atomic parts + pParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) + qParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) + viscosity, & !< viscosity for dislocation glide in Pa s + fattack, & !< attack frequency in Hz + rhoSglScatter, & !< standard deviation of scatter in initial dislocation density + surfaceTransmissivity, & !< transmissivity at free surface + grainboundaryTransmissivity, & !< transmissivity at grain boundary (identified by different texture) + CFLfactor, & !< safety factor for CFL flux condition + fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) + rhoSglRandom, & + rhoSglRandomBinning, & + linetensionEffect, & + edgeJogFactor + + real(pReal), dimension(:,:), allocatable, private :: & + rhoSglEdgePos0, & !< initial edge_pos dislocation density per slip system for each family and instance + rhoSglEdgeNeg0, & !< initial edge_neg dislocation density per slip system for each family and instance + rhoSglScrewPos0, & !< initial screw_pos dislocation density per slip system for each family and instance + rhoSglScrewNeg0, & !< initial screw_neg dislocation density per slip system for each family and instance + rhoDipEdge0, & !< initial edge dipole dislocation density per slip system for each family and instance + rhoDipScrew0, & !< initial screw dipole dislocation density per slip system for each family and instance + lambda0PerSlipFamily, & !< mean free path prefactor for each family and instance + lambda0, & !< mean free path prefactor for each slip system and instance + burgersPerSlipFamily, & !< absolute length of burgers vector [m] for each family and instance + burgers, & !< absolute length of burgers vector [m] for each slip system and instance + interactionSlipSlip !< coefficients for slip-slip interaction for each interaction type and instance + + real(pReal), dimension(:,:,:), allocatable, private :: & + minDipoleHeightPerSlipFamily, & !< minimum stable edge/screw dipole height for each family and instance + minDipoleHeight, & !< minimum stable edge/screw dipole height for each slip system and instance + peierlsStressPerSlipFamily, & !< Peierls stress (edge and screw) + peierlsStress, & !< Peierls stress (edge and screw) + forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance + forestProjectionScrew, & !< matrix of forest projections of screw dislocations for each instance + interactionMatrixSlipSlip !< interaction matrix of the different slip systems for each instance + + real(pReal), dimension(:,:,:,:), allocatable, private :: & + lattice2slip, & !< orthogonal transformation matrix from lattice coordinate system to slip coordinate system (passive rotation !!!) + rhoDotEdgeJogsOutput, & + sourceProbability + + real(pReal), dimension(:,:,:,:,:), allocatable, private :: & + rhoDotFluxOutput, & + rhoDotMultiplicationOutput, & + rhoDotSingle2DipoleGlideOutput, & + rhoDotAthermalAnnihilationOutput, & + rhoDotThermalAnnihilationOutput, & + nonSchmidProjection !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) + + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & + compatibility !< slip system compatibility between me and my neighbors + + real(pReal), dimension(:,:), allocatable, private :: & + nonSchmidCoeff + + logical, dimension(:), allocatable, private :: & + shortRangeStressCorrection, & !< flag indicating the use of the short range stress correction by a excess density gradient term + probabilisticMultiplication + + enum, bind(c) + enumerator :: undefined_ID, & + rho_ID, & + delta_ID, & + rho_edge_ID, & + rho_screw_ID, & + rho_sgl_ID, & + delta_sgl_ID, & + rho_sgl_edge_ID, & + rho_sgl_edge_pos_ID, & + rho_sgl_edge_neg_ID, & + rho_sgl_screw_ID, & + rho_sgl_screw_pos_ID, & + rho_sgl_screw_neg_ID, & + rho_sgl_mobile_ID, & + rho_sgl_edge_mobile_ID, & + rho_sgl_edge_pos_mobile_ID, & + rho_sgl_edge_neg_mobile_ID, & + rho_sgl_screw_mobile_ID, & + rho_sgl_screw_pos_mobile_ID, & + rho_sgl_screw_neg_mobile_ID, & + rho_sgl_immobile_ID, & + rho_sgl_edge_immobile_ID, & + rho_sgl_edge_pos_immobile_ID, & + rho_sgl_edge_neg_immobile_ID, & + rho_sgl_screw_immobile_ID, & + rho_sgl_screw_pos_immobile_ID, & + rho_sgl_screw_neg_immobile_ID, & + rho_dip_ID, & + delta_dip_ID, & + rho_dip_edge_ID, & + rho_dip_screw_ID, & + excess_rho_ID, & + excess_rho_edge_ID, & + excess_rho_screw_ID, & + rho_forest_ID, & + shearrate_ID, & + resolvedstress_ID, & + resolvedstress_external_ID, & + resolvedstress_back_ID, & + resistance_ID, & + rho_dot_ID, & + rho_dot_sgl_ID, & + rho_dot_sgl_mobile_ID, & + rho_dot_dip_ID, & + rho_dot_gen_ID, & + rho_dot_gen_edge_ID, & + rho_dot_gen_screw_ID, & + rho_dot_sgl2dip_ID, & + rho_dot_sgl2dip_edge_ID, & + rho_dot_sgl2dip_screw_ID, & + rho_dot_ann_ath_ID, & + rho_dot_ann_the_ID, & + rho_dot_ann_the_edge_ID, & + rho_dot_ann_the_screw_ID, & + rho_dot_edgejogs_ID, & + rho_dot_flux_ID, & + rho_dot_flux_mobile_ID, & + rho_dot_flux_edge_ID, & + rho_dot_flux_screw_ID, & + velocity_edge_pos_ID, & + velocity_edge_neg_ID, & + velocity_screw_pos_ID, & + velocity_screw_neg_ID, & + slipdirectionx_ID, & + slipdirectiony_ID, & + slipdirectionz_ID, & + slipnormalx_ID, & + slipnormaly_ID, & + slipnormalz_ID, & + fluxdensity_edge_posx_ID, & + fluxdensity_edge_posy_ID, & + fluxdensity_edge_posz_ID, & + fluxdensity_edge_negx_ID, & + fluxdensity_edge_negy_ID, & + fluxdensity_edge_negz_ID, & + fluxdensity_screw_posx_ID, & + fluxdensity_screw_posy_ID, & + fluxdensity_screw_posz_ID, & + fluxdensity_screw_negx_ID, & + fluxdensity_screw_negy_ID, & + fluxdensity_screw_negz_ID, & + maximumdipoleheight_edge_ID, & + maximumdipoleheight_screw_ID, & + accumulatedshear_ID, & + dislocationstress_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_nonlocal_outputID !< ID of each post result output + + public :: & + plastic_nonlocal_init, & + plastic_nonlocal_stateInit, & + plastic_nonlocal_aTolState, & + plastic_nonlocal_microstructure, & + plastic_nonlocal_LpAndItsTangent, & + plastic_nonlocal_dotState, & + plastic_nonlocal_deltaState, & + plastic_nonlocal_updateCompatibility, & + plastic_nonlocal_postResults + + private :: & + plastic_nonlocal_kinetics, & + plastic_nonlocal_dislocationstress + + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_init(fileUnit) +use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +use math, only: math_Mandel3333to66, & + math_Voigt66to3333, & + math_mul3x3, & + math_transpose33 +use IO, only: IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF +use debug, only: debug_level, & + debug_constitutive, & + debug_levelBasic +use mesh, only: mesh_NcpElems, & + mesh_maxNips, & + mesh_maxNipNeighbors +use material, only: phase_plasticity, & + homogenization_maxNgrains, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_NONLOCAL_label, & + PLASTICITY_NONLOCAL_ID, & + plasticState, & + MATERIAL_partPhase ,& + material_phase +use lattice +use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + +implicit none +integer(pInt), intent(in) :: fileUnit + +!*** local variables +integer(pInt), allocatable, dimension(:) :: chunkPos +integer(pInt) :: phase, & + maxNinstances, & + maxTotalNslip, & + f, & ! index of my slip family + instance, & ! index of my instance of this plasticity + l, & + ns, & ! short notation for total number of active slip systems for the current instance + o, & ! index of my output + s, & ! index of my slip system + s1, & ! index of my slip system + s2, & ! index of my slip system + it, & ! index of my interaction type + t, & ! index of dislocation type + c, & ! index of dislocation character + Nchunks_SlipSlip = 0_pInt, & + Nchunks_SlipFamilies = 0_pInt, & + Nchunks_nonSchmid = 0_pInt, & + mySize = 0_pInt ! to suppress warnings, safe as init is called only once + character(len=65536) :: & + tag = '', & + line = '' + + integer(pInt) :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState + + + integer(pInt) :: NofMyPhase + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) + if (maxNinstances == 0) return ! we don't have to do anything if there's no instance for this constitutive law + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances + +!*** memory allocation for global variables + +allocate(plastic_nonlocal_sizeDotState(maxNinstances), source=0_pInt) +allocate(plastic_nonlocal_sizeDependentState(maxNinstances), source=0_pInt) +allocate(plastic_nonlocal_sizeState(maxNinstances), source=0_pInt) +allocate(plastic_nonlocal_sizePostResults(maxNinstances), source=0_pInt) +allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) +allocate(plastic_nonlocal_Noutput(maxNinstances), source=0_pInt) +allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) + plastic_nonlocal_output = '' +allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) +allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) +allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) +allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) +allocate(totalNslip(maxNinstances), source=0_pInt) +allocate(atomicVolume(maxNinstances), source=0.0_pReal) +allocate(Dsd0(maxNinstances), source=-1.0_pReal) +allocate(selfDiffusionEnergy(maxNinstances), source=0.0_pReal) +allocate(aTolRho(maxNinstances), source=0.0_pReal) +allocate(aTolShear(maxNinstances), source=0.0_pReal) +allocate(significantRho(maxNinstances), source=0.0_pReal) +allocate(significantN(maxNinstances), source=0.0_pReal) +allocate(cutoffRadius(maxNinstances), source=-1.0_pReal) +allocate(doublekinkwidth(maxNinstances), source=0.0_pReal) +allocate(solidSolutionEnergy(maxNinstances), source=0.0_pReal) +allocate(solidSolutionSize(maxNinstances), source=0.0_pReal) +allocate(solidSolutionConcentration(maxNinstances), source=0.0_pReal) +allocate(pParam(maxNinstances), source=1.0_pReal) +allocate(qParam(maxNinstances), source=1.0_pReal) +allocate(viscosity(maxNinstances), source=0.0_pReal) +allocate(fattack(maxNinstances), source=0.0_pReal) +allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) +allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) +allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) +allocate(surfaceTransmissivity(maxNinstances), source=1.0_pReal) +allocate(grainboundaryTransmissivity(maxNinstances), source=-1.0_pReal) +allocate(CFLfactor(maxNinstances), source=2.0_pReal) +allocate(fEdgeMultiplication(maxNinstances), source=0.0_pReal) +allocate(linetensionEffect(maxNinstances), source=0.0_pReal) +allocate(edgeJogFactor(maxNinstances), source=1.0_pReal) +allocate(shortRangeStressCorrection(maxNinstances), source=.false.) +allocate(probabilisticMultiplication(maxNinstances), source=.false.) + +allocate(rhoSglEdgePos0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) +allocate(rhoSglEdgeNeg0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) +allocate(rhoSglScrewPos0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) +allocate(rhoSglScrewNeg0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) +allocate(rhoDipEdge0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) +allocate(rhoDipScrew0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) +allocate(burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) +allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) +allocate(interactionSlipSlip(lattice_maxNinteraction,maxNinstances), source=0.0_pReal) +allocate(minDipoleHeightPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=-1.0_pReal) +allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=0.0_pReal) +allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), source=0.0_pReal) + + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through phases of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_SlipSlip = maxval(lattice_InteractionSlipSlip(:,:,phase)) + Nchunks_nonSchmid = lattice_NnonSchmid(phase) + endif + cycle + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then ! one of my phases. do not short-circuit here (.and. with next if statement). It's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('rho') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('delta') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('delta_sgl') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_sgl_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_pos') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_neg') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_pos') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_neg') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_pos_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_neg_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_pos_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_neg_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_pos_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_neg_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_pos_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_screw_neg_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dip') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('delta_dip') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_dip_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dip_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dip_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('excess_rho') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('excess_rho_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('excess_rho_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_forest') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_forest_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = shearrate_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_external') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_external_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_back') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_back_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resistance') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resistance_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_sgl') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_sgl_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_dip') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_dip_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_gen') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_gen_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_gen_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_sgl2dip') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_sgl2dip_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_sgl2dip_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_ann_ath') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_ath_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_ann_the') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_ann_the_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_ann_the_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_edgejogs') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_edgejogs_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_flux') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_flux_mobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_mobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_flux_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_dot_flux_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('velocity_edge_pos') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_edge_pos_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('velocity_edge_neg') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_edge_neg_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('velocity_screw_pos') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_pos_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('velocity_screw_neg') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_neg_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('slipdirection.x') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionx_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('slipdirection.y') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectiony_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('slipdirection.z') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionz_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('slipnormal.x') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalx_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('slipnormal.y') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormaly_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('slipnormal.z') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalz_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_edge_pos.x') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posx_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_edge_pos.y') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posy_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_edge_pos.z') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posz_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_edge_neg.x') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negx_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_edge_neg.y') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negy_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_edge_neg.z') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negz_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_screw_pos.x') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posx_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_screw_pos.y') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posy_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_screw_pos.z') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posz_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_screw_neg.x') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negx_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_screw_neg.y') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negy_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('fluxdensity_screw_neg.z') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negz_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('maximumdipoleheight_edge') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_edge_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('maximumdipoleheight_screw') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_screw_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear','accumulated_shear') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = accumulatedshear_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('dislocationstress') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = dislocationstress_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + case ('nslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt + do f = 1_pInt, Nchunks_SlipFamilies + Nslip(f,instance) = IO_intValue(line,chunkPos,1_pInt+f) + enddo + case ('rhosgledgepos0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglEdgePos0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case ('rhosgledgeneg0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglEdgeNeg0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case ('rhosglscrewpos0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglScrewPos0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case ('rhosglscrewneg0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglScrewNeg0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case ('rhodipedge0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoDipEdge0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case ('rhodipscrew0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoDipScrew0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case ('lambda0') + do f = 1_pInt, Nchunks_SlipFamilies + lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case ('burgers') + do f = 1_pInt, Nchunks_SlipFamilies + burgersPerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case('cutoffradius','r') + cutoffRadius(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('minimumdipoleheightedge','ddipminedge') + do f = 1_pInt, Nchunks_SlipFamilies + minDipoleHeightPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case('minimumdipoleheightscrew','ddipminscrew') + do f = 1_pInt, Nchunks_SlipFamilies + minDipoleHeightPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case('atomicvolume') + atomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('selfdiffusionprefactor','dsd0') + Dsd0(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('selfdiffusionenergy','qsd') + selfDiffusionEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('atol_rho','atol_density','absolutetolerancedensity','absolutetolerance_density') + aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('atol_shear','atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') + aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('significantrho','significant_rho','significantdensity','significant_density') + significantRho(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('significantn','significant_n','significantdislocations','significant_dislcations') + significantN(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('interaction_slipslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') + do it = 1_pInt,Nchunks_SlipSlip + interactionSlipSlip(it,instance) = IO_floatValue(line,chunkPos,1_pInt+it) + enddo + case('linetension','linetensioneffect','linetension_effect') + linetensionEffect(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('edgejog','edgejogs','edgejogeffect','edgejog_effect') + edgeJogFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('peierlsstressedge','peierlsstress_edge') + do f = 1_pInt, Nchunks_SlipFamilies + peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case('peierlsstressscrew','peierlsstress_screw') + do f = 1_pInt, Nchunks_SlipFamilies + peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case('doublekinkwidth') + doublekinkwidth(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('solidsolutionenergy') + solidSolutionEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('solidsolutionsize') + solidSolutionSize(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('solidsolutionconcentration') + solidSolutionConcentration(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('p') + pParam(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('q') + qParam(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('viscosity','glideviscosity') + viscosity(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('attackfrequency','fattack') + fattack(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('rhosglscatter') + rhoSglScatter(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('rhosglrandom') + rhoSglRandom(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('rhosglrandombinning') + rhoSglRandomBinning(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('surfacetransmissivity') + surfaceTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('grainboundarytransmissivity') + grainboundaryTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('cflfactor') + CFLfactor(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('fedgemultiplication','edgemultiplicationfactor','edgemultiplication') + fEdgeMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) + case('shortrangestresscorrection') + shortRangeStressCorrection(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal + case ('nonschmid_coefficients') + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_label//')') + do f = 1_pInt,Nchunks_nonSchmid + nonSchmidCoeff(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) + enddo + case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') + probabilisticMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal + end select + endif; endif + enddo parsingFile + + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then + instance = phase_plasticityInstance(phase) + if (sum(Nslip(:,instance)) <= 0_pInt) & + call IO_error(211_pInt,ext_msg='Nslip ('//PLASTICITY_NONLOCAL_label//')') + do o = 1_pInt,maxval(phase_Noutput) + if(len(plastic_nonlocal_output(o,instance)) > 64_pInt) & + call IO_error(666_pInt) + enddo + do f = 1_pInt,lattice_maxNslipFamily + if (Nslip(f,instance) > 0_pInt) then + if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglEdgePos0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglEdgeNeg0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglEdgeNeg0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglScrewPos0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglScrewPos0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglScrewNeg0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglScrewNeg0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoDipEdge0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoDipScrew0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') + if (burgersPerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='Burgers ('//PLASTICITY_NONLOCAL_label//')') + if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') + if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='minimumDipoleHeightEdge ('//PLASTICITY_NONLOCAL_label//')') + if (minDipoleHeightPerSlipFamily(f,2,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='minimumDipoleHeightScrew ('//PLASTICITY_NONLOCAL_label//')') + if (peierlsStressPerSlipFamily(f,1,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='peierlsStressEdge ('//PLASTICITY_NONLOCAL_label//')') + if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') + endif + enddo + if (any(interactionSlipSlip(1:maxval(lattice_interactionSlipSlip(:,:,phase)),instance) < 0.0_pReal)) & + call IO_error(211_pInt,ext_msg='interaction_SlipSlip ('//PLASTICITY_NONLOCAL_label//')') + if (linetensionEffect(instance) < 0.0_pReal .or. linetensionEffect(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='linetension ('//PLASTICITY_NONLOCAL_label//')') + if (edgeJogFactor(instance) < 0.0_pReal .or. edgeJogFactor(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='edgejog ('//PLASTICITY_NONLOCAL_label//')') + if (cutoffRadius(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='r ('//PLASTICITY_NONLOCAL_label//')') + if (atomicVolume(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') + if (Dsd0(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='selfDiffusionPrefactor ('//PLASTICITY_NONLOCAL_label//')') + if (selfDiffusionEnergy(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='selfDiffusionEnergy ('//PLASTICITY_NONLOCAL_label//')') + if (aTolRho(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='aTol_rho ('//PLASTICITY_NONLOCAL_label//')') + if (aTolShear(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='aTol_shear ('//PLASTICITY_NONLOCAL_label//')') + if (significantRho(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='significantRho ('//PLASTICITY_NONLOCAL_label//')') + if (significantN(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='significantN ('//PLASTICITY_NONLOCAL_label//')') + if (doublekinkwidth(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='doublekinkwidth ('//PLASTICITY_NONLOCAL_label//')') + if (solidSolutionEnergy(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='solidSolutionEnergy ('//PLASTICITY_NONLOCAL_label//')') + if (solidSolutionSize(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='solidSolutionSize ('//PLASTICITY_NONLOCAL_label//')') + if (solidSolutionConcentration(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='solidSolutionConcentration ('//PLASTICITY_NONLOCAL_label//')') + if (pParam(instance) <= 0.0_pReal .or. pParam(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='p ('//PLASTICITY_NONLOCAL_label//')') + if (qParam(instance) < 1.0_pReal .or. qParam(instance) > 2.0_pReal) & + call IO_error(211_pInt,ext_msg='q ('//PLASTICITY_NONLOCAL_label//')') + if (viscosity(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='viscosity ('//PLASTICITY_NONLOCAL_label//')') + if (fattack(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='attackFrequency ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglScatter(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglRandom(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglRandomBinning(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') + if (surfaceTransmissivity(instance) < 0.0_pReal .or. surfaceTransmissivity(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='surfaceTransmissivity ('//PLASTICITY_NONLOCAL_label//')') + if (grainboundaryTransmissivity(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='grainboundaryTransmissivity ('//PLASTICITY_NONLOCAL_label//')') + if (CFLfactor(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='CFLfactor ('//PLASTICITY_NONLOCAL_label//')') + if (fEdgeMultiplication(instance) < 0.0_pReal .or. fEdgeMultiplication(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='edgemultiplicationfactor ('//PLASTICITY_NONLOCAL_label//')') + + + !*** determine total number of active slip systems + Nslip(1:lattice_maxNslipFamily,instance) = min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase), & + Nslip(1:lattice_maxNslipFamily,instance) ) ! we can't use more slip systems per family than specified in lattice + totalNslip(instance) = sum(Nslip(1:lattice_maxNslipFamily,instance)) + endif myPhase +enddo sanityChecks + + +!*** allocation of variables whose size depends on the total number of active slip systems + +maxTotalNslip = maxval(totalNslip) + +allocate(iRhoU(maxTotalNslip,4,maxNinstances), source=0_pInt) +allocate(iRhoB(maxTotalNslip,4,maxNinstances), source=0_pInt) +allocate(iRhoD(maxTotalNslip,2,maxNinstances), source=0_pInt) +allocate(iV(maxTotalNslip,4,maxNinstances), source=0_pInt) +allocate(iD(maxTotalNslip,2,maxNinstances), source=0_pInt) +allocate(iGamma(maxTotalNslip,maxNinstances), source=0_pInt) +allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) +allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) +allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) +allocate(burgers(maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) +allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=2.0_pReal) + +allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) +allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) +allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) +allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) +allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) +allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) + +allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), & + source=0.0_pReal) +allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) +allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) +allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), source=0.0_pReal) + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + NofMyPhase=count(material_phase==phase) + myPhase2: if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID .and. NofMyPhase/=0) then + instance = phase_plasticityInstance(phase) + !*** Inverse lookup of my slip system family and the slip system in lattice + + l = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily + do s = 1_pInt,Nslip(f,instance) + l = l + 1_pInt + slipFamily(l,instance) = f + slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt, phase)) + s + enddo; enddo + + + !*** determine size of state array + + ns = totalNslip(instance) + + sizeDotState = int(size(BASICSTATES),pInt) * ns + sizeDependentState = int(size(DEPENDENTSTATES),pInt) * ns + sizeState = sizeDotState + sizeDependentState & + + int(size(OTHERSTATES),pInt) * ns + sizeDeltaState = sizeDotState + + !*** determine indices to state array + + l = 0_pInt + do t = 1_pInt,4_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iRhoU(s,t,instance) = l + enddo + enddo + do t = 1_pInt,4_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iRhoB(s,t,instance) = l + enddo + enddo + do c = 1_pInt,2_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iRhoD(s,c,instance) = l + enddo + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iGamma(s,instance) = l + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iRhoF(s,instance) = l + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iTauF(s,instance) = l + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iTauB(s,instance) = l + enddo + do t = 1_pInt,4_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iV(s,t,instance) = l + enddo + enddo + do c = 1_pInt,2_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iD(s,c,instance) = l + enddo + enddo + if (iD(ns,2,instance) /= sizeState) & ! check if last index is equal to size of state + call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') + + + !*** determine size of postResults array + + outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) + select case(plastic_nonlocal_outputID(o,instance)) + case( rho_ID, & + delta_ID, & + rho_edge_ID, & + rho_screw_ID, & + rho_sgl_ID, & + delta_sgl_ID, & + rho_sgl_edge_ID, & + rho_sgl_edge_pos_ID, & + rho_sgl_edge_neg_ID, & + rho_sgl_screw_ID, & + rho_sgl_screw_pos_ID, & + rho_sgl_screw_neg_ID, & + rho_sgl_mobile_ID, & + rho_sgl_edge_mobile_ID, & + rho_sgl_edge_pos_mobile_ID, & + rho_sgl_edge_neg_mobile_ID, & + rho_sgl_screw_mobile_ID, & + rho_sgl_screw_pos_mobile_ID, & + rho_sgl_screw_neg_mobile_ID, & + rho_sgl_immobile_ID, & + rho_sgl_edge_immobile_ID, & + rho_sgl_edge_pos_immobile_ID, & + rho_sgl_edge_neg_immobile_ID, & + rho_sgl_screw_immobile_ID, & + rho_sgl_screw_pos_immobile_ID, & + rho_sgl_screw_neg_immobile_ID, & + rho_dip_ID, & + delta_dip_ID, & + rho_dip_edge_ID, & + rho_dip_screw_ID, & + excess_rho_ID, & + excess_rho_edge_ID, & + excess_rho_screw_ID, & + rho_forest_ID, & + shearrate_ID, & + resolvedstress_ID, & + resolvedstress_external_ID, & + resolvedstress_back_ID, & + resistance_ID, & + rho_dot_ID, & + rho_dot_sgl_ID, & + rho_dot_sgl_mobile_ID, & + rho_dot_dip_ID, & + rho_dot_gen_ID, & + rho_dot_gen_edge_ID, & + rho_dot_gen_screw_ID, & + rho_dot_sgl2dip_ID, & + rho_dot_sgl2dip_edge_ID, & + rho_dot_sgl2dip_screw_ID, & + rho_dot_ann_ath_ID, & + rho_dot_ann_the_ID, & + rho_dot_ann_the_edge_ID, & + rho_dot_ann_the_screw_ID, & + rho_dot_edgejogs_ID, & + rho_dot_flux_ID, & + rho_dot_flux_mobile_ID, & + rho_dot_flux_edge_ID, & + rho_dot_flux_screw_ID, & + velocity_edge_pos_ID, & + velocity_edge_neg_ID, & + velocity_screw_pos_ID, & + velocity_screw_neg_ID, & + slipdirectionx_ID, & + slipdirectiony_ID, & + slipdirectionz_ID, & + slipnormalx_ID, & + slipnormaly_ID, & + slipnormalz_ID, & + fluxdensity_edge_posx_ID, & + fluxdensity_edge_posy_ID, & + fluxdensity_edge_posz_ID, & + fluxdensity_edge_negx_ID, & + fluxdensity_edge_negy_ID, & + fluxdensity_edge_negz_ID, & + fluxdensity_screw_posx_ID, & + fluxdensity_screw_posy_ID, & + fluxdensity_screw_posz_ID, & + fluxdensity_screw_negx_ID, & + fluxdensity_screw_negy_ID, & + fluxdensity_screw_negz_ID, & + maximumdipoleheight_edge_ID, & + maximumdipoleheight_screw_ID, & + accumulatedshear_ID ) + mySize = totalNslip(instance) + case(dislocationstress_ID) + mySize = 6_pInt + case default + end select + + if (mySize > 0_pInt) then ! any meaningful output found + plastic_nonlocal_sizePostResult(o,instance) = mySize + plastic_nonlocal_sizePostResults(instance) = plastic_nonlocal_sizePostResults(instance) + mySize + endif + enddo outputsLoop + + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_nonlocal_sizePostResults(instance) + plasticState(phase)%nonlocal = .true. + plasticState(phase)%nSlip = totalNslip(instance) + plasticState(phase)%nTwin = 0_pInt + plasticState(phase)%nTrans= 0_pInt + allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state (iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) + + do s1 = 1_pInt,ns + f = slipFamily(s1,instance) + + !*** burgers vector, mean free path prefactor and minimum dipole distance for each slip system + + burgers(s1,instance) = burgersPerSlipFamily(f,instance) + lambda0(s1,instance) = lambda0PerSlipFamily(f,instance) + minDipoleHeight(s1,1:2,instance) = minDipoleHeightPerSlipFamily(f,1:2,instance) + peierlsStress(s1,1:2,instance) = peierlsStressPerSlipFamily(f,1:2,instance) + + do s2 = 1_pInt,ns + + !*** calculation of forest projections for edge and screw dislocations. s2 acts as forest for s1 + + forestProjectionEdge(s1,s2,instance) & + = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),phase), & + lattice_st(1:3,slipSystemLattice(s2,instance),phase))) ! forest projection of edge dislocations is the projection of (t = b x n) onto the slip normal of the respective slip plane + + forestProjectionScrew(s1,s2,instance) & + = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),phase), & + lattice_sd(1:3,slipSystemLattice(s2,instance),phase))) ! forest projection of screw dislocations is the projection of b onto the slip normal of the respective splip plane + + !*** calculation of interaction matrices + + interactionMatrixSlipSlip(s1,s2,instance) & + = interactionSlipSlip(lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & + slipSystemLattice(s2,instance), & + phase), instance) + + !*** colinear slip system (only makes sense for fcc like it is defined here) + + if (lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & + slipSystemLattice(s2,instance), & + phase) == 3_pInt) then + colinearSystem(s1,instance) = s2 + endif + + enddo + + !*** rotation matrix from lattice configuration to slip system + + lattice2slip(1:3,1:3,s1,instance) & + = math_transpose33( reshape([ lattice_sd(1:3, slipSystemLattice(s1,instance), phase), & + -lattice_st(1:3, slipSystemLattice(s1,instance), phase), & + lattice_sn(1:3, slipSystemLattice(s1,instance), phase)], [3,3])) + enddo + + + !*** combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) + !* four types t: + !* 1) positive screw at positive resolved stress + !* 2) positive screw at negative resolved stress + !* 3) negative screw at positive resolved stress + !* 4) negative screw at negative resolved stress + + do s = 1_pInt,ns + do l = 1_pInt,lattice_NnonSchmid(phase) + nonSchmidProjection(1:3,1:3,1,s,instance) = nonSchmidProjection(1:3,1:3,1,s,instance) & + + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l,slipSystemLattice(s,instance),phase) + nonSchmidProjection(1:3,1:3,2,s,instance) = nonSchmidProjection(1:3,1:3,2,s,instance) & + + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l+1,slipSystemLattice(s,instance),phase) + enddo + nonSchmidProjection(1:3,1:3,3,s,instance) = -nonSchmidProjection(1:3,1:3,2,s,instance) + nonSchmidProjection(1:3,1:3,4,s,instance) = -nonSchmidProjection(1:3,1:3,1,s,instance) + forall (t = 1:4) & + nonSchmidProjection(1:3,1:3,t,s,instance) = nonSchmidProjection(1:3,1:3,t,s,instance) & + + lattice_Sslip(1:3,1:3,1,slipSystemLattice(s,instance),phase) + enddo + + call plastic_nonlocal_aTolState(phase,instance) + endif myPhase2 + + enddo initializeInstances + +end subroutine plastic_nonlocal_init + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the initial microstructural state for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- + +subroutine plastic_nonlocal_stateInit() +use IO, only: IO_error +use lattice, only: lattice_maxNslipFamily +use math, only: math_sampleGaussVar +use mesh, only: mesh_ipVolume, & + mesh_NcpElems, & + mesh_element, & + FE_Nips, & + FE_geomtype +use material, only: material_phase, & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticity ,& + PLASTICITY_NONLOCAL_ID +implicit none + +integer(pInt) :: e, & + i, & + ns, & ! short notation for total number of active slip systems + f, & ! index of lattice family + from, & + upto, & + s, & ! index of slip system + t, & + j, & + instance, & + maxNinstances +real(pReal), dimension(2) :: noise +real(pReal), dimension(4) :: rnd +real(pReal) meanDensity, & + totalVolume, & + densityBinning, & + minimumIpVolume + +maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) + +do instance = 1_pInt,maxNinstances + ns = totalNslip(instance) + + ! randomly distribute dislocation segments on random slip system and of random type in the volume + if (rhoSglRandom(instance) > 0.0_pReal) then + + ! get the total volume of the instance + + minimumIpVolume = huge(1.0_pReal) + totalVolume = 0.0_pReal + do e = 1_pInt,mesh_NcpElems + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & + .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then + totalVolume = totalVolume + mesh_ipVolume(i,e) + minimumIpVolume = min(minimumIpVolume, mesh_ipVolume(i,e)) + endif + enddo + enddo + densityBinning = rhoSglRandomBinning(instance) / minimumIpVolume ** (2.0_pReal / 3.0_pReal) + + ! subsequently fill random ips with dislocation segments until we reach the desired overall density + + meanDensity = 0.0_pReal + do while(meanDensity < rhoSglRandom(instance)) + call random_number(rnd) + e = nint(rnd(1)*real(mesh_NcpElems,pReal)+0.5_pReal,pInt) + i = nint(rnd(2)*real(FE_Nips(FE_geomtype(mesh_element(2,e))),pReal)+0.5_pReal,pInt) + if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & + .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then + s = nint(rnd(3)*real(ns,pReal)+0.5_pReal,pInt) + t = nint(rnd(4)*4.0_pReal+0.5_pReal,pInt) + meanDensity = meanDensity + densityBinning * mesh_ipVolume(i,e) / totalVolume + plasticState(phaseAt(1,i,e))%state0(iRhoU(s,t,instance),phaseAt(1,i,e)) = & + plasticState(phaseAt(1,i,e))%state0(iRhoU(s,t,instance),phaseAt(1,i,e)) & + + densityBinning + endif + enddo + ! homogeneous distribution of density with some noise + else + do e = 1_pInt,mesh_NcpElems + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & + .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then + do f = 1_pInt,lattice_maxNslipFamily + from = 1_pInt + sum(Nslip(1:f-1_pInt,instance)) + upto = sum(Nslip(1:f,instance)) + do s = from,upto + do j = 1_pInt,2_pInt + noise(j) = math_sampleGaussVar(0.0_pReal, rhoSglScatter(instance)) + enddo + plasticState(phaseAt(1,i,e))%state0(iRhoU(s,1,instance),phasememberAt(1,i,e)) = & + rhoSglEdgePos0(f,instance) + noise(1) + plasticState(phaseAt(1,i,e))%state0(iRhoU(s,2,instance),phasememberAt(1,i,e)) = & + rhoSglEdgeNeg0(f,instance) + noise(1) + plasticState(phaseAt(1,i,e))%state0(iRhoU(s,3,instance),phasememberAt(1,i,e)) = & + rhoSglScrewPos0(f,instance) + noise(2) + plasticState(phaseAt(1,i,e))%state0(iRhoU(s,4,instance),phasememberAt(1,i,e)) = & + rhoSglScrewNeg0(f,instance) + noise(2) + enddo + plasticState(phaseAt(1,i,e))%state0(iRhoD(from:upto,1,instance),phasememberAt(1,i,e)) = & + rhoDipEdge0(f,instance) + plasticState(phaseAt(1,i,e))%state0(iRhoD(from:upto,2,instance),phasememberAt(1,i,e)) = & + rhoDipScrew0(f,instance) + enddo + endif + enddo + enddo + endif +enddo + +end subroutine plastic_nonlocal_stateInit + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the relevant state values for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_aTolState(ph,instance) + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + integer(pInt) :: & + ns, & + t, c + + ns = totalNslip(instance) + forall (t = 1_pInt:4_pInt) + plasticState(ph)%aTolState(iRhoU(1:ns,t,instance)) = aTolRho(instance) + plasticState(ph)%aTolState(iRhoB(1:ns,t,instance)) = aTolRho(instance) + end forall + forall (c = 1_pInt:2_pInt) & + plasticState(ph)%aTolState(iRhoD(1:ns,c,instance)) = aTolRho(instance) + + plasticState(ph)%aTolState(iGamma(1:ns,instance)) = aTolShear(instance) + +end subroutine plastic_nonlocal_aTolState + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates quantities characterizing the microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_microstructure(Fe, Fp, ip, el) +use IO, only: & + IO_error +use math, only: & + pi, & + math_mul33x3, & + math_mul3x3, & + math_inv33, & + math_transpose33 +use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelExtensive, & + debug_levelSelective, & + debug_i, & + debug_e +use mesh, only: & + mesh_element, & + mesh_ipNeighborhood, & + mesh_ipCoordinates, & + mesh_ipVolume, & + mesh_ipAreaNormal, & + mesh_ipArea, & + FE_NipNeighbors, & + mesh_maxNipNeighbors, & + FE_geomtype, & + FE_celltype +use material, only: & + material_phase, & + phase_localPlasticity, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance +use lattice, only: & + lattice_sd, & + lattice_st, & + lattice_mu, & + lattice_nu, & + lattice_structure, & + LATTICE_bcc_ID, & + LATTICE_fcc_ID + +implicit none + +integer(pInt), intent(in) :: ip, & ! current integration point + el ! current element +real(pReal), dimension(3,3), intent(in) :: & + Fe, & ! elastic deformation gradient + Fp ! elastic deformation gradient + + integer(pInt) :: & + ph, & !< phase + of, & !< offset + np, & !< neighbor phase + no !< nieghbor offset + +integer(pInt) neighbor_el, & ! element number of neighboring material point + neighbor_ip, & ! integration point of neighboring material point + instance, & ! my instance of this plasticity + neighbor_instance, & ! instance of this plasticity of neighboring material point + neighbor_phase, & + ns, & ! total number of active slip systems at my material point + neighbor_ns, & ! total number of active slip systems at neighboring material point + c, & ! index of dilsocation character (edge, screw) + s, & ! slip system index + t, & ! index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) + dir, & + n, & + nRealNeighbors ! number of really existing neighbors +integer(pInt), dimension(2) :: neighbors +real(pReal) FVsize, & + correction, & + myRhoForest +real(pReal), dimension(2) :: rhoExcessGradient, & + rhoExcessGradient_over_rho, & + rhoTotal +real(pReal), dimension(3) :: rhoExcessDifferences, & + normal_latticeConf +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + rhoForest, & ! forest dislocation density + tauBack, & ! back stress from pileup on same slip system + tauThreshold ! threshold shear stress +real(pReal), dimension(3,3) :: invFe, & ! inverse of elastic deformation gradient + invFp, & ! inverse of plastic deformation gradient + connections, & + invConnections +real(pReal), dimension(3,mesh_maxNipNeighbors) :: & + connection_latticeConf +real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + rhoExcess +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & + rhoDip ! dipole dislocation density (edge, screw) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & + rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & + totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + myInteractionMatrix ! corrected slip interaction matrix +real(pReal), dimension(2,maxval(totalNslip),mesh_maxNipNeighbors) :: & + neighbor_rhoExcess, & ! excess density at neighboring material point + neighbor_rhoTotal ! total density at neighboring material point +real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & + m ! direction of dislocation motion + +ph = phaseAt(1,ip,el) +of = phasememberAt(1,ip,el) +instance = phase_plasticityInstance(ph) +ns = totalNslip(instance) + +!*** get basic states + + +forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) +endforall +forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & + rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities + +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoSgl) < significantRho(instance)) & + rhoSgl = 0.0_pReal +where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoDip) < significantRho(instance)) & + rhoDip = 0.0_pReal + +!*** calculate the forest dislocation density +!*** (= projection of screw and edge dislocations) + +forall (s = 1_pInt:ns) & + rhoForest(s) = dot_product((sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1)), & + forestProjectionEdge(s,1:ns,instance)) & + + dot_product((sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2)), & + forestProjectionScrew(s,1:ns,instance)) + + +!*** calculate the threshold shear stress for dislocation slip +!*** coefficients are corrected for the line tension effect +!*** (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals) + +myInteractionMatrix = 0.0_pReal +myInteractionMatrix(1:ns,1:ns) = interactionMatrixSlipSlip(1:ns,1:ns,instance) +if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc + do s = 1_pInt,ns + myRhoForest = max(rhoForest(s),significantRho(instance)) + correction = ( 1.0_pReal - linetensionEffect(instance) & + + linetensionEffect(instance) & + * log(0.35_pReal * burgers(s,instance) * sqrt(myRhoForest)) & + / log(0.35_pReal * burgers(s,instance) * 1e6_pReal)) ** 2.0_pReal + myInteractionMatrix(s,1:ns) = correction * myInteractionMatrix(s,1:ns) + enddo +endif +forall (s = 1_pInt:ns) & + tauThreshold(s) = lattice_mu(ph) * burgers(s,instance) & + * sqrt(dot_product((sum(abs(rhoSgl),2) + sum(abs(rhoDip),2)), myInteractionMatrix(s,1:ns))) + + +!*** calculate the dislocation stress of the neighboring excess dislocation densities +!*** zero for material points of local plasticity + +tauBack = 0.0_pReal + +if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) then + invFe = math_inv33(Fe) + invFp = math_inv33(Fp) + rhoExcess(1,1:ns) = rhoSgl(1:ns,1) - rhoSgl(1:ns,2) + rhoExcess(2,1:ns) = rhoSgl(1:ns,3) - rhoSgl(1:ns,4) + FVsize = mesh_ipVolume(ip,el) ** (1.0_pReal/3.0_pReal) + + !* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities + + nRealNeighbors = 0_pInt + neighbor_rhoTotal = 0.0_pReal + do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) + neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) + np = phaseAt(1,neighbor_ip,neighbor_el) + no = phasememberAt(1,neighbor_ip,neighbor_el) + if (neighbor_el > 0 .and. neighbor_ip > 0) then + neighbor_phase = material_phase(1,neighbor_ip,neighbor_el) + neighbor_instance = phase_plasticityInstance(neighbor_phase) + neighbor_ns = totalNslip(neighbor_instance) + if (.not. phase_localPlasticity(neighbor_phase) & + .and. neighbor_instance == instance) then ! same instance should be same structure + if (neighbor_ns == ns) then + nRealNeighbors = nRealNeighbors + 1_pInt + forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) + + neighbor_rhoExcess(c,s,n) = & + max(plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no), 0.0_pReal) & ! positive mobiles + - max(plasticState(np)%state(iRhoU(s,2*c,neighbor_instance), no), 0.0_pReal) ! negative mobiles + neighbor_rhoTotal(c,s,n) = & + max(plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no), 0.0_pReal) & ! positive mobiles + + max(plasticState(np)%state(iRhoU(s,2*c,neighbor_instance), no), 0.0_pReal) & ! negative mobiles + + abs(plasticState(np)%state(iRhoB(s,2*c-1,neighbor_instance),no)) & ! positive deads + + abs(plasticState(np)%state(iRhoB(s,2*c,neighbor_instance), no)) & ! negative deads + + max(plasticState(np)%state(iRhoD(s,c,neighbor_instance), no), 0.0_pReal) ! dipoles + + endforall + connection_latticeConf(1:3,n) = & + math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & + - mesh_ipCoordinates(1:3,ip,el)) + normal_latticeConf = math_mul33x3(math_transpose33(invFp), mesh_ipAreaNormal(1:3,n,ip,el)) + if (math_mul3x3(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) then ! neighboring connection points in opposite direction to face normal: must be periodic image + connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el) & + / mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell + endif + else + ! different number of active slip systems + call IO_error(-1_pInt,ext_msg='different number of active slip systems in neighboring IPs of same crystal structure') + endif + else + ! local neighbor or different lattice structure or different constitution instance -> use central values instead + connection_latticeConf(1:3,n) = 0.0_pReal + neighbor_rhoExcess(1:2,1:ns,n) = rhoExcess + endif + else + ! free surface -> use central values instead + connection_latticeConf(1:3,n) = 0.0_pReal + neighbor_rhoExcess(1:2,1:ns,n) = rhoExcess + endif + enddo + + + !* loop through the slip systems and calculate the dislocation gradient by + !* 1. interpolation of the excess density in the neighorhood + !* 2. interpolation of the dead dislocation density in the central volume + + m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),ph) + m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),ph) + + do s = 1_pInt,ns + + !* gradient from interpolation of neighboring excess density + + do c = 1_pInt,2_pInt + do dir = 1_pInt,3_pInt + neighbors(1) = 2_pInt * dir - 1_pInt + neighbors(2) = 2_pInt * dir + connections(dir,1:3) = connection_latticeConf(1:3,neighbors(1)) & + - connection_latticeConf(1:3,neighbors(2)) + rhoExcessDifferences(dir) = neighbor_rhoExcess(c,s,neighbors(1)) & + - neighbor_rhoExcess(c,s,neighbors(2)) + enddo + invConnections = math_inv33(connections) + if (all(abs(invConnections) <= tiny(0.0_pReal))) & ! check for failed in version (math_inv33 returns 0) and avoid floating point equality comparison + call IO_error(-1_pInt,ext_msg='back stress calculation: inversion error') + rhoExcessGradient(c) = math_mul3x3(m(1:3,s,c), & + math_mul33x3(invConnections,rhoExcessDifferences)) + enddo + + !* plus gradient from deads + + do t = 1_pInt,4_pInt + c = (t - 1_pInt) / 2_pInt + 1_pInt + rhoExcessGradient(c) = rhoExcessGradient(c) + rhoSgl(s,t+4_pInt) / FVsize + enddo + + !* normalized with the total density + + rhoExcessGradient_over_rho = 0.0_pReal + forall (c = 1_pInt:2_pInt) & + rhoTotal(c) = (sum(abs(rhoSgl(s,[2*c-1,2*c,2*c+3,2*c+4]))) + rhoDip(s,c) & + + sum(neighbor_rhoTotal(c,s,:))) / real(1_pInt + nRealNeighbors,pReal) + forall (c = 1_pInt:2_pInt, rhoTotal(c) > 0.0_pReal) & + rhoExcessGradient_over_rho(c) = rhoExcessGradient(c) / rhoTotal(c) + + !* gives the local stress correction when multiplied with a factor + + tauBack(s) = - lattice_mu(ph) * burgers(s,instance) / (2.0_pReal * pi) & + * (rhoExcessGradient_over_rho(1) / (1.0_pReal - lattice_nu(ph)) & + + rhoExcessGradient_over_rho(2)) + + enddo +endif + + +!*** set dependent states +plasticState(ph)%state(iRhoF(1:ns,instance),of) = rhoForest +plasticState(ph)%state(iTauF(1:ns,instance),of) = tauThreshold +plasticState(ph)%state(iTauB(1:ns,instance),of) = tauBack + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip + write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', rhoForest + write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold/1e6 + write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', tauBack/1e6 + endif +#endif + +end subroutine plastic_nonlocal_microstructure + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates kinetics +!-------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & + tauThreshold, c, Temperature, ip, el) + +use debug, only: debug_level, & + debug_constitutive, & + debug_levelExtensive, & + debug_levelSelective, & + debug_i, & + debug_e +use material, only: material_phase, & + phase_plasticityInstance + +implicit none + +!*** input variables +integer(pInt), intent(in) :: ip, & !< current integration point + el, & !< current element number + c !< dislocation character (1:edge, 2:screw) +real(pReal), intent(in) :: Temperature !< temperature +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))), & + intent(in) :: tau, & !< resolved external shear stress (without non Schmid effects) + tauNS, & !< resolved external shear stress (including non Schmid effects) + tauThreshold !< threshold shear stress + +!*** output variables +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))), & + intent(out) :: v, & !< velocity + dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) + dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) + +!*** local variables +integer(pInt) :: instance, & !< current instance of this plasticity + ns, & !< short notation for the total number of active slip systems + s !< index of my current slip system +real(pReal) tauRel_P, & + tauRel_S, & + tauEff, & !< effective shear stress + tPeierls, & !< waiting time in front of a peierls barriers + tSolidSolution, & !< waiting time in front of a solid solution obstacle + vViscous, & !< viscous glide velocity + dtPeierls_dtau, & !< derivative with respect to resolved shear stress + dtSolidSolution_dtau, & !< derivative with respect to resolved shear stress + meanfreepath_S, & !< mean free travel distance for dislocations between two solid solution obstacles + meanfreepath_P, & !< mean free travel distance for dislocations between two Peierls barriers + jumpWidth_P, & !< depth of activated area + jumpWidth_S, & !< depth of activated area + activationLength_P, & !< length of activated dislocation line + activationLength_S, & !< length of activated dislocation line + activationVolume_P, & !< volume that needs to be activated to overcome barrier + activationVolume_S, & !< volume that needs to be activated to overcome barrier + activationEnergy_P, & !< energy that is needed to overcome barrier + activationEnergy_S, & !< energy that is needed to overcome barrier + criticalStress_P, & !< maximum obstacle strength + criticalStress_S, & !< maximum obstacle strength + mobility !< dislocation mobility + + +instance = phase_plasticityInstance(material_phase(1_pInt,ip,el)) +ns = totalNslip(instance) + +v = 0.0_pReal +dv_dtau = 0.0_pReal +dv_dtauNS = 0.0_pReal + + +if (Temperature > 0.0_pReal) then + do s = 1_pInt,ns + if (abs(tau(s)) > tauThreshold(s)) then + + !* Peierls contribution + !* Effective stress includes non Schmid constributions + !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity + + tauEff = max(0.0_pReal, abs(tauNS(s)) - tauThreshold(s)) ! ensure that the effective stress is positive + meanfreepath_P = burgers(s,instance) + jumpWidth_P = burgers(s,instance) + activationLength_P = doublekinkwidth(instance) * burgers(s,instance) + activationVolume_P = activationLength_P * jumpWidth_P * burgers(s,instance) + criticalStress_P = peierlsStress(s,c,instance) + activationEnergy_P = criticalStress_P * activationVolume_P + tauRel_P = min(1.0_pReal, tauEff / criticalStress_P) ! ensure that the activation probability cannot become greater than one + tPeierls = 1.0_pReal / fattack(instance) & + * exp(activationEnergy_P / (KB * Temperature) & + * (1.0_pReal - tauRel_P**pParam(instance))**qParam(instance)) + if (tauEff < criticalStress_P) then + dtPeierls_dtau = tPeierls * pParam(instance) * qParam(instance) * activationVolume_P / (KB * Temperature) & + * (1.0_pReal - tauRel_P**pParam(instance))**(qParam(instance)-1.0_pReal) & + * tauRel_P**(pParam(instance)-1.0_pReal) + else + dtPeierls_dtau = 0.0_pReal + endif + + + !* Contribution from solid solution strengthening + !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity + + tauEff = abs(tau(s)) - tauThreshold(s) + meanfreepath_S = burgers(s,instance) / sqrt(solidSolutionConcentration(instance)) + jumpWidth_S = solidSolutionSize(instance) * burgers(s,instance) + activationLength_S = burgers(s,instance) / sqrt(solidSolutionConcentration(instance)) + activationVolume_S = activationLength_S * jumpWidth_S * burgers(s,instance) + activationEnergy_S = solidSolutionEnergy(instance) + criticalStress_S = activationEnergy_S / activationVolume_S + tauRel_S = min(1.0_pReal, tauEff / criticalStress_S) ! ensure that the activation probability cannot become greater than one + tSolidSolution = 1.0_pReal / fattack(instance) & + * exp(activationEnergy_S / (KB * Temperature) & + * (1.0_pReal - tauRel_S**pParam(instance))**qParam(instance)) + if (tauEff < criticalStress_S) then + dtSolidSolution_dtau = tSolidSolution * pParam(instance) * qParam(instance) & + * activationVolume_S / (KB * Temperature) & + * (1.0_pReal - tauRel_S**pParam(instance))**(qParam(instance)-1.0_pReal) & + * tauRel_S**(pParam(instance)-1.0_pReal) + else + dtSolidSolution_dtau = 0.0_pReal + endif + + + !* viscous glide velocity + + tauEff = abs(tau(s)) - tauThreshold(s) + mobility = burgers(s,instance) / viscosity(instance) + vViscous = mobility * tauEff + + + !* Mean velocity results from waiting time at peierls barriers and solid solution obstacles with respective meanfreepath of + !* free flight at glide velocity in between. + !* adopt sign from resolved stress + + v(s) = sign(1.0_pReal,tau(s)) & + / (tPeierls / meanfreepath_P + tSolidSolution / meanfreepath_S + 1.0_pReal / vViscous) + dv_dtau(s) = v(s) * v(s) * (dtSolidSolution_dtau / meanfreepath_S & + + mobility / (vViscous * vViscous)) + dv_dtauNS(s) = v(s) * v(s) * dtPeierls_dtau / meanfreepath_P + endif + enddo +endif + + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_kinetics at el ip',el,ip + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold / 1e6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tau / MPa', tau / 1e6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauNS / MPa', tauNS / 1e6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> v / 1e-3m/s', v * 1e3 + write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtau', dv_dtau + write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtauNS', dv_dtauNS + endif +#endif + +end subroutine plastic_nonlocal_kinetics + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el) + +use math, only: math_Plain3333to99, & + math_mul6x6, & + math_mul33xx33, & + math_Mandel6to33 +use debug, only: debug_level, & + debug_constitutive, & + debug_levelExtensive, & + debug_levelSelective, & + debug_i, & + debug_e +use material, only: material_phase, & + plasticState, & + phaseAt, phasememberAt,& + phase_plasticityInstance +use lattice, only: lattice_Sslip, & + lattice_Sslip_v, & + lattice_NnonSchmid +use mesh, only: mesh_ipVolume + +implicit none + +!*** input variables +integer(pInt), intent(in) :: ip, & !< current integration point + el !< current element number +real(pReal), intent(in) :: Temperature !< temperature +real(pReal), dimension(6), intent(in) :: Tstar_v !< 2nd Piola-Kirchhoff stress in Mandel notation + + +!*** output variables +real(pReal), dimension(3,3), intent(out) :: Lp !< plastic velocity gradient +real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 !< derivative of Lp with respect to Tstar (9x9 matrix) + +!*** local variables +integer(pInt) instance, & !< current instance of this plasticity + ns, & !< short notation for the total number of active slip systems + i, & + j, & + k, & + l, & + ph, & !phase number + of, & !offset + t, & !< dislocation type + s, & !< index of my current slip system + sLattice !< index of my current slip system according to lattice order +real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 !< derivative of Lp with respect to Tstar (3x3x3x3 matrix) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & + rhoSgl !< single dislocation densities (including blocked) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & + v, & !< velocity + tauNS, & !< resolved shear stress including non Schmid and backstress terms + dv_dtau, & !< velocity derivative with respect to the shear stress + dv_dtauNS !< velocity derivative with respect to the shear stress +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + tau, & !< resolved shear stress including backstress terms + gdotTotal, & !< shear rate + tauBack, & !< back stress from dislocation gradients on same slip system + tauThreshold !< threshold shear stress +!*** shortcut for mapping +ph = phaseAt(1_pInt,ip,el) +of = phasememberAt(1_pInt,ip,el) + +!*** initialize local variables + +Lp = 0.0_pReal +dLp_dTstar3333 = 0.0_pReal + +instance = phase_plasticityInstance(ph) +ns = totalNslip(instance) + + +!*** shortcut to state variables + + +forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + + rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) +endforall +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoSgl) < significantRho(instance)) & + rhoSgl = 0.0_pReal + +tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) +tauThreshold = plasticState(ph)%state(iTauF(1:ns,instance),of) + + +!*** get resolved shear stress +!*** for screws possible non-schmid contributions are also taken into account + +do s = 1_pInt,ns + sLattice = slipSystemLattice(s,instance) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauNS(s,1) = tau(s) + tauNS(s,2) = tau(s) + if (tau(s) > 0.0_pReal) then + tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance)) + tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance)) + else + tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance)) + tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance)) + endif +enddo +forall (t = 1_pInt:4_pInt) & + tauNS(1:ns,t) = tauNS(1:ns,t) + tauBack ! add backstress +tau = tau + tauBack ! add backstress + + +!*** get dislocation velocity and its tangent and store the velocity in the state array + +! edges +call plastic_nonlocal_kinetics(v(1:ns,1), dv_dtau(1:ns,1), dv_dtauNS(1:ns,1), & + tau(1:ns), tauNS(1:ns,1), tauThreshold(1:ns), & + 1_pInt, Temperature, ip, el) +v(1:ns,2) = v(1:ns,1) +dv_dtau(1:ns,2) = dv_dtau(1:ns,1) +dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) + +!screws +if (lattice_NnonSchmid(ph) == 0_pInt) then ! no non-Schmid contributions + forall(t = 3_pInt:4_pInt) + v(1:ns,t) = v(1:ns,1) + dv_dtau(1:ns,t) = dv_dtau(1:ns,1) + dv_dtauNS(1:ns,t) = dv_dtauNS(1:ns,1) + endforall +else ! take non-Schmid contributions into account + do t = 3_pInt,4_pInt + call plastic_nonlocal_kinetics(v(1:ns,t), dv_dtau(1:ns,t), dv_dtauNS(1:ns,t), & + tau(1:ns), tauNS(1:ns,t), tauThreshold(1:ns), & + 2_pInt , Temperature, ip, el) + enddo +endif + + +!*** store velocity in state + +forall (t = 1_pInt:4_pInt) & + plasticState(ph)%state(iV(1:ns,t,instance),of) = v(1:ns,t) +!*** Bauschinger effect + +forall (s = 1_pInt:ns, t = 5_pInt:8_pInt, rhoSgl(s,t) * v(s,t-4_pInt) < 0.0_pReal) & + rhoSgl(s,t-4_pInt) = rhoSgl(s,t-4_pInt) + abs(rhoSgl(s,t)) + + +!*** Calculation of Lp and its tangent + +gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * burgers(1:ns,instance) + +do s = 1_pInt,ns + sLattice = slipSystemLattice(s,instance) + Lp = Lp + gdotTotal(s) * lattice_Sslip(1:3,1:3,1,sLattice,ph) + + ! Schmid contributions to tangent + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & + dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & + + lattice_Sslip(i,j,1,sLattice,ph) * lattice_Sslip(k,l,1,sLattice,ph) & + * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * burgers(s,instance) + + ! non Schmid contributions to tangent + if (tau(s) > 0.0_pReal) then + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & + dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & + + lattice_Sslip(i,j,1,sLattice,ph) & + * ( nonSchmidProjection(k,l,1,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & + + nonSchmidProjection(k,l,3,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & + * burgers(s,instance) + else + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & + dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & + + lattice_Sslip(i,j,1,sLattice,ph) & + * ( nonSchmidProjection(k,l,2,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & + + nonSchmidProjection(k,l,4,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & + * burgers(s,instance) + endif +enddo +dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) + + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_LpandItsTangent at el ip',el,ip + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> gdot total / 1e-3',gdotTotal*1e3_pReal + write(6,'(a,/,3(12x,3(f12.7,1x),/))') '<< CONST >> Lp',transpose(Lp) + endif +#endif + +end subroutine plastic_nonlocal_LpAndItsTangent + + + +!-------------------------------------------------------------------------------------------------- +!> @brief (instantaneous) incremental change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_deltaState(Tstar_v,ip,el) +use debug, only: debug_level, & + debug_constitutive, & + debug_levelBasic, & + debug_levelExtensive, & + debug_levelSelective, & + debug_i, & + debug_e +use math, only: pi, & + math_mul6x6 +use lattice, only: lattice_Sslip_v ,& + lattice_mu, & + lattice_nu +use mesh, only: mesh_ipVolume +use material, only: material_phase, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + +implicit none +integer(pInt), intent(in) :: ip, & ! current grain number + el ! current element number +real(pReal), dimension(6), intent(in) :: Tstar_v ! current 2nd Piola-Kirchhoff stress in Mandel notation + + + integer(pInt) :: & + ph, & !< phase + of !< offset + +integer(pInt) ::instance, & ! current instance of this plasticity + ns, & ! short notation for the total number of active slip systems + c, & ! character of dislocation + t, & ! type of dislocation + s, & ! index of my current slip system + sLattice ! index of my current slip system according to lattice order +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + deltaRho, & ! density increment + deltaRhoRemobilization, & ! density increment by remobilization + deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & + rhoSgl ! current single dislocation densities (positive/negative screw and edge without dipoles) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + v ! dislocation glide velocity +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + tau, & ! current resolved shear stress + tauBack ! current back stress from pileups on same slip system +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) + dLower, & ! minimum stable dipole distance for edges and screws + dUpper, & ! current maximum stable dipole distance for edges and screws + dUpperOld, & ! old maximum stable dipole distance for edges and screws + deltaDUpper ! change in maximum stable dipole distance for edges and screws + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_deltaState at el ip ',el,ip +#endif + + ph = phaseAt(1,ip,el) + of = phasememberAt(1,ip,el) + instance = phase_plasticityInstance(ph) + ns = totalNslip(instance) + + +!*** shortcut to state variables + + forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) + v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) +endforall +forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) + rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities + dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) +endforall + tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) + +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoSgl) < significantRho(instance)) & + rhoSgl = 0.0_pReal +where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoDip) < significantRho(instance)) & + rhoDip = 0.0_pReal + + + + +!**************************************************************************** +!*** dislocation remobilization (bauschinger effect) + +deltaRhoRemobilization = 0.0_pReal +do t = 1_pInt,4_pInt + do s = 1_pInt,ns + if (rhoSgl(s,t+4_pInt) * v(s,t) < 0.0_pReal) then + deltaRhoRemobilization(s,t) = abs(rhoSgl(s,t+4_pInt)) + rhoSgl(s,t) = rhoSgl(s,t) + abs(rhoSgl(s,t+4_pInt)) + deltaRhoRemobilization(s,t+4_pInt) = - rhoSgl(s,t+4_pInt) + rhoSgl(s,t+4_pInt) = 0.0_pReal + endif + enddo +enddo + + + +!**************************************************************************** +!*** calculate dipole formation and dissociation by stress change + +!*** calculate limits for stable dipole height + +do s = 1_pInt,ns + sLattice = slipSystemLattice(s,instance) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) + if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal +enddo +dLower = minDipoleHeight(1:ns,1:2,instance) +dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) / (4.0_pReal * pi * abs(tau)) + + +forall (c = 1_pInt:2_pInt) + where(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+& + abs(rhoSgl(1:ns,2*c+3))+abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)) >= tiny(0.0_pReal)) & + dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & + dUpper(1:ns,c)) +end forall +dUpper = max(dUpper,dLower) +deltaDUpper = dUpper - dUpperOld + + +!*** dissociation by stress increase +deltaRhoDipole2SingleStress = 0.0_pReal +forall (c=1_pInt:2_pInt, s=1_pInt:ns, deltaDUpper(s,c) < 0.0_pReal .and. & + abs(dUpperOld(s,c) - dLower(s,c)) > tiny(0.0_pReal)) & + deltaRhoDipole2SingleStress(s,8_pInt+c) = rhoDip(s,c) * deltaDUpper(s,c) & + / (dUpperOld(s,c) - dLower(s,c)) + +forall (t=1_pInt:4_pInt) & + deltaRhoDipole2SingleStress(1_pInt:ns,t) = -0.5_pReal & + * deltaRhoDipole2SingleStress(1_pInt:ns,(t-1_pInt)/2_pInt+9_pInt) + + +!*** store new maximum dipole height in state + +forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & + plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) + + + +!**************************************************************************** +!*** assign the changes in the dislocation densities to deltaState + +deltaRho = deltaRhoRemobilization & + + deltaRhoDipole2SingleStress +plasticState(ph)%deltaState(:,of) = 0.0_pReal +forall (s = 1:ns, t = 1_pInt:4_pInt) + plasticState(ph)%deltaState(iRhoU(s,t,instance),of)= deltaRho(s,t) + plasticState(ph)%deltaState(iRhoB(s,t,instance),of) = deltaRho(s,t+4_pInt) +endforall +forall (s = 1:ns, c = 1_pInt:2_pInt) & + plasticState(ph)%deltaState(iRhoD(s,c,instance),of) = deltaRho(s,c+8_pInt) + + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then + write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(1:ns,1:8) + write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress + endif +#endif + +end subroutine plastic_nonlocal_deltaState + +!--------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!--------------------------------------------------------------------------------------------------- +subroutine plastic_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, & + timestep,subfrac, ip,el) + +use prec, only: DAMASK_NaN +use numerics, only: numerics_integrationMode, & + numerics_timeSyncing +use IO, only: IO_error +use debug, only: debug_level, & + debug_constitutive, & + debug_levelBasic, & + debug_levelExtensive, & + debug_levelSelective, & + debug_g, & + debug_i, & + debug_e +use math, only: math_mul6x6, & + math_mul3x3, & + math_mul33x3, & + math_mul33x33, & + math_inv33, & + math_det33, & + math_transpose33, & + pi +use mesh, only: mesh_NcpElems, & + mesh_maxNips, & + mesh_element, & + mesh_ipNeighborhood, & + mesh_ipVolume, & + mesh_ipArea, & + mesh_ipAreaNormal, & + FE_NipNeighbors, & + FE_geomtype, & + FE_celltype +use material, only: homogenization_maxNgrains, & + material_phase, & + phase_plasticityInstance, & + phase_localPlasticity, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticity ,& + PLASTICITY_NONLOCAL_ID +use lattice, only: lattice_Sslip_v, & + lattice_sd, & + lattice_st ,& + lattice_mu, & + lattice_nu, & + lattice_structure, & + LATTICE_bcc_ID, & + LATTICE_fcc_ID + +implicit none + +!*** input variables +integer(pInt), intent(in) :: ip, & !< current integration point + el !< current element number +real(pReal), intent(in) :: Temperature, & !< temperature + timestep !< substepped crystallite time increment +real(pReal), dimension(6), intent(in) :: Tstar_v !< current 2nd Piola-Kirchhoff stress in Mandel notation +real(pReal), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + subfrac !< fraction of timestep at the beginning of the substepped crystallite time increment +real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + Fe, & !< elastic deformation gradient + Fp !< plastic deformation gradient + + +!*** local variables +integer(pInt) :: ph, & + instance, & !< current instance of this plasticity + neighbor_instance, & !< instance of my neighbor's plasticity + ns, & !< short notation for the total number of active slip systems + c, & !< character of dislocation + n, & !< index of my current neighbor + neighbor_el, & !< element number of my neighbor + neighbor_ip, & !< integration point of my neighbor + neighbor_n, & !< neighbor index pointing to me when looking from my neighbor + opposite_neighbor, & !< index of my opposite neighbor + opposite_ip, & !< ip of my opposite neighbor + opposite_el, & !< element index of my opposite neighbor + opposite_n, & !< neighbor index pointing to me when looking from my opposite neighbor + t, & !< type of dislocation + o,& !< offset shortcut + no,& !< neighbour offset shortcut + p,& !< phase shortcut + np,& !< neighbour phase shortcut + topp, & !< type of dislocation with opposite sign to t + s, & !< index of my current slip system + sLattice !< index of my current slip system according to lattice order +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),10) :: & + rhoDot, & !< density evolution + rhoDotMultiplication, & !< density evolution by multiplication + rhoDotFlux, & !< density evolution by flux + rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide) + rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation + rhoDotThermalAnnihilation !< density evolution by thermal annihilation +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & + rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) + rhoSglOriginal, & + neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) + rhoSgl0, & !< single dislocation densities at start of cryst inc (positive/negative screw and edge without dipoles) + my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & + v, & !< current dislocation glide velocity + v0, & !< dislocation glide velocity at start of cryst inc + my_v, & !< dislocation glide velocity of central ip + neighbor_v, & !< dislocation glide velocity of enighboring ip + gdot !< shear rates +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + rhoForest, & !< forest dislocation density + tauThreshold, & !< threshold shear stress + tau, & !< current resolved shear stress + tauBack, & !< current back stress from pileups on same slip system + vClimb, & !< climb velocity of edge dipoles + nSources +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & + rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) + rhoDipOriginal, & + dLower, & !< minimum stable dipole distance for edges and screws + dUpper !< current maximum stable dipole distance for edges and screws +real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & + m !< direction of dislocation motion +real(pReal), dimension(3,3) :: my_F, & !< my total deformation gradient + neighbor_F, & !< total deformation gradient of my neighbor + my_Fe, & !< my elastic deformation gradient + neighbor_Fe, & !< elastic deformation gradient of my neighbor + Favg !< average total deformation gradient of me and my neighbor +real(pReal), dimension(3) :: normal_neighbor2me, & !< interface normal pointing from my neighbor to me in neighbor's lattice configuration + normal_neighbor2me_defConf, & !< interface normal pointing from my neighbor to me in shared deformed configuration + normal_me2neighbor, & !< interface normal pointing from me to my neighbor in my lattice configuration + normal_me2neighbor_defConf !< interface normal pointing from me to my neighbor in shared deformed configuration +real(pReal) area, & !< area of the current interface + transmissivity, & !< overall transmissivity of dislocation flux to neighboring material point + lineLength, & !< dislocation line length leaving the current interface + selfDiffusion, & !< self diffusion + rnd, & + meshlength +logical considerEnteringFlux, & + considerLeavingFlux + + + p = phaseAt(1,ip,el) + o = phasememberAt(1,ip,el) + + + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & + write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_dotState at el ip ',el,ip +#endif + +ph = material_phase(1_pInt,ip,el) +instance = phase_plasticityInstance(ph) +ns = totalNslip(instance) + +tau = 0.0_pReal +gdot = 0.0_pReal + + +!*** shortcut to state variables + + +forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) + v(s,t) = plasticState(p)%state(iV (s,t,instance),o) +endforall +forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) + rhoDip(s,c) = max(plasticState(p)%state(iRhoD(s,c,instance),o), 0.0_pReal) ! ensure positive dipole densities +endforall +rhoForest = plasticState(p)%state(iRhoF(1:ns,instance),o) +tauThreshold = plasticState(p)%state(iTauF(1:ns,instance),o) +tauBack = plasticState(p)%state(iTauB(1:ns,instance),o) + +rhoSglOriginal = rhoSgl +rhoDipOriginal = rhoDip +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoSgl) < significantRho(instance)) & + rhoSgl = 0.0_pReal +where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoDip) < significantRho(instance)) & + rhoDip = 0.0_pReal + +if (numerics_timeSyncing) then + forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + rhoSgl0(s,t) = max(plasticState(p)%state0(iRhoU(s,t,instance),o), 0.0_pReal) + rhoSgl0(s,t+4_pInt) = plasticState(p)%state0(iRhoB(s,t,instance),o) + v0(s,t) = plasticState(p)%state0(iV (s,t,instance),o) + endforall + where (abs(rhoSgl0) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & + .or. abs(rhoSgl0) < significantRho(instance)) & + rhoSgl0 = 0.0_pReal +endif + + + +!*** sanity check for timestep + +if (timestep <= 0.0_pReal) then ! if illegal timestep... Why here and not on function entry?? + plasticState(p)%dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) + return +endif + + + +!**************************************************************************** +!*** Calculate shear rate + +forall (t = 1_pInt:4_pInt) & + gdot(1_pInt:ns,t) = rhoSgl(1_pInt:ns,t) * burgers(1:ns,instance) * v(1:ns,t) + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then + write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip + write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot + endif +#endif + + + +!**************************************************************************** +!*** calculate limits for stable dipole height + +do s = 1_pInt,ns ! loop over slip systems + sLattice = slipSystemLattice(s,instance) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) + if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal +enddo + +dLower = minDipoleHeight(1:ns,1:2,instance) +dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) & + / (4.0_pReal * pi * abs(tau)) +forall (c = 1_pInt:2_pInt) + where(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+& + abs(rhoSgl(1:ns,2*c+3))+abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)) >= tiny(0.0_pReal)) & + dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & + dUpper(1:ns,c)) +end forall +dUpper = max(dUpper,dLower) + +!**************************************************************************** +!*** calculate dislocation multiplication + +rhoDotMultiplication = 0.0_pReal +if (lattice_structure(ph) == LATTICE_bcc_ID) then ! BCC + forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) + rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication + * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path + ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation + rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication + * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path + ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation + endforall + +else ! ALL OTHER STRUCTURES + if (probabilisticMultiplication(instance)) then + meshlength = mesh_ipVolume(ip,el)**0.333_pReal + where(sum(rhoSgl(1:ns,1:4),2) > 0.0_pReal) + nSources = (sum(rhoSgl(1:ns,1:2),2) * fEdgeMultiplication(instance) + sum(rhoSgl(1:ns,3:4),2)) & + / sum(rhoSgl(1:ns,1:4),2) * meshlength / lambda0(1:ns,instance)*sqrt(rhoForest(1:ns)) + elsewhere + nSources = meshlength / lambda0(1:ns,instance) * sqrt(rhoForest(1:ns)) + endwhere + do s = 1_pInt,ns + if (nSources(s) < 1.0_pReal) then + if (sourceProbability(s,1_pInt,ip,el) > 1.0_pReal) then + call random_number(rnd) + sourceProbability(s,1_pInt,ip,el) = rnd + !$OMP FLUSH(sourceProbability) + endif + if (sourceProbability(s,1_pInt,ip,el) > 1.0_pReal - nSources(s)) then + rhoDotMultiplication(s,1:4) = sum(rhoSglOriginal(s,1:4) * abs(v(s,1:4))) / meshlength + endif + else + sourceProbability(s,1_pInt,ip,el) = 2.0_pReal + rhoDotMultiplication(s,1:4) = & + (sum(abs(gdot(s,1:2))) * fEdgeMultiplication(instance) + sum(abs(gdot(s,3:4)))) & + / burgers(s,instance) * sqrt(rhoForest(s)) / lambda0(s,instance) + endif + enddo +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) & + write(6,'(a,/,4(12x,12(f12.5,1x),/,/))') '<< CONST >> sources', nSources +#endif + else + rhoDotMultiplication(1:ns,1:4) = spread( & + (sum(abs(gdot(1:ns,1:2)),2) * fEdgeMultiplication(instance) + sum(abs(gdot(1:ns,3:4)),2)) & + * sqrt(rhoForest(1:ns)) / lambda0(1:ns,instance) / burgers(1:ns,instance), 2, 4) + endif +endif + + + +!**************************************************************************** +!*** calculate dislocation fluxes (only for nonlocal plasticity) + +rhoDotFlux = 0.0_pReal +!? why needed here +if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then ! only for nonlocal plasticity + + !*** check CFL (Courant-Friedrichs-Lewy) condition for flux + + if (any( abs(gdot) > 0.0_pReal & ! any active slip system ... + .and. CFLfactor(instance) * abs(v) * timestep & + > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then + write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip + write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', & + maxval(abs(v), abs(gdot) > 0.0_pReal & + .and. CFLfactor(instance) * abs(v) * timestep & + > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el))), & + ' at a timestep of ',timestep + write(6,'(a)') '<< CONST >> enforcing cutback !!!' + endif +#endif + plasticState(p)%dotState = DAMASK_NaN ! -> return NaN and, hence, enforce cutback + return + endif + + + !*** be aware of the definition of lattice_st = lattice_sd x lattice_sn !!! + !*** opposite sign to our p vector in the (s,p,n) triplet !!! + + m(1:3,1:ns,1) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) + m(1:3,1:ns,2) = -lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) + m(1:3,1:ns,3) = -lattice_st(1:3, slipSystemLattice(1:ns,instance), ph) + m(1:3,1:ns,4) = lattice_st(1:3, slipSystemLattice(1:ns,instance), ph) + + my_Fe = Fe(1:3,1:3,1_pInt,ip,el) + my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1_pInt,ip,el)) + + do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) ! loop through my neighbors +! write(6,*) 'c' + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) + neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) + neighbor_n = mesh_ipNeighborhood(3,n,ip,el) + np = phaseAt(1,neighbor_ip,neighbor_el) + no = phasememberAt(1,neighbor_ip,neighbor_el) + + opposite_neighbor = n + mod(n,2_pInt) - mod(n+1_pInt,2_pInt) + opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el) + opposite_ip = mesh_ipNeighborhood(2,opposite_neighbor,ip,el) + opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el) + + if (neighbor_n > 0_pInt) then ! if neighbor exists, average deformation gradient + neighbor_instance = phase_plasticityInstance(material_phase(1_pInt,neighbor_ip,neighbor_el)) + neighbor_Fe = Fe(1:3,1:3,1_pInt,neighbor_ip,neighbor_el) + neighbor_F = math_mul33x33(neighbor_Fe, Fp(1:3,1:3,1_pInt,neighbor_ip,neighbor_el)) + Favg = 0.5_pReal * (my_F + neighbor_F) + else ! if no neighbor, take my value as average + Favg = my_F + endif + + + !* FLUX FROM MY NEIGHBOR TO ME + !* This is only considered, if I have a neighbor of nonlocal plasticity + !* (also nonlocal constitutive law with local properties) that is at least a little bit + !* compatible. + !* If it's not at all compatible, no flux is arriving, because everything is dammed in front of + !* my neighbor's interface. + !* The entering flux from my neighbor will be distributed on my slip systems according to the + !*compatibility + + considerEnteringFlux = .false. + neighbor_v = 0.0_pReal ! needed for check of sign change in flux density below + neighbor_rhoSgl = 0.0_pReal + if (neighbor_n > 0_pInt) then + if (phase_plasticity(material_phase(1,neighbor_ip,neighbor_el)) == PLASTICITY_NONLOCAL_ID & + .and. any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) & + considerEnteringFlux = .true. + endif + + if (considerEnteringFlux) then + if(numerics_timeSyncing .and. (subfrac(1_pInt,neighbor_ip,neighbor_el) /= subfrac(1_pInt,ip,el))) & + then ! for timesyncing: in case of a timestep at the interface we have to use "state0" to make sure that fluxes n both sides are equal + forall (s = 1:ns, t = 1_pInt:4_pInt) + + neighbor_v(s,t) = plasticState(np)%state0(iV (s,t,neighbor_instance),no) + neighbor_rhoSgl(s,t) = max(plasticState(np)%state0(iRhoU(s,t,neighbor_instance),no),0.0_pReal) + + endforall + else + forall (s = 1:ns, t = 1_pInt:4_pInt) + neighbor_v(s,t) = plasticState(np)%state(iV (s,t,neighbor_instance),no) + neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance),no), & + 0.0_pReal) + endforall + endif + + where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < significantN(instance) & + .or. neighbor_rhoSgl < significantRho(instance)) & + neighbor_rhoSgl = 0.0_pReal + normal_neighbor2me_defConf = math_det33(Favg) * math_mul33x3(math_inv33(transpose(Favg)), & + mesh_ipAreaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!) + normal_neighbor2me = math_mul33x3(transpose(neighbor_Fe), normal_neighbor2me_defConf) & + / math_det33(neighbor_Fe) ! interface normal in the lattice configuration of my neighbor + area = mesh_ipArea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me) + normal_neighbor2me = normal_neighbor2me / norm2(normal_neighbor2me) ! normalize the surface normal to unit length + do s = 1_pInt,ns + do t = 1_pInt,4_pInt + c = (t + 1_pInt) / 2 + topp = t + mod(t,2_pInt) - mod(t+1_pInt,2_pInt) + if (neighbor_v(s,t) * math_mul3x3(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me + .and. v(s,t) * neighbor_v(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density + lineLength = neighbor_rhoSgl(s,t) * neighbor_v(s,t) & + * math_mul3x3(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface + where (compatibility(c,1_pInt:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility... + rhoDotFlux(1_pInt:ns,t) = rhoDotFlux(1_pInt:ns,t) & + + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type + * compatibility(c,1_pInt:ns,s,n,ip,el) ** 2.0_pReal + where (compatibility(c,1_pInt:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility... + rhoDotFlux(1_pInt:ns,topp) = rhoDotFlux(1_pInt:ns,topp) & + + lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type + * compatibility(c,1_pInt:ns,s,n,ip,el) ** 2.0_pReal + endif + enddo + enddo + endif + + + !* FLUX FROM ME TO MY NEIGHBOR + !* This is not considered, if my opposite neighbor has a different constitutive law than nonlocal (still considered for nonlocal law with lcal properties). + !* Then, we assume, that the opposite(!) neighbor sends an equal amount of dislocations to me. + !* So the net flux in the direction of my neighbor is equal to zero: + !* leaving flux to neighbor == entering flux from opposite neighbor + !* In case of reduced transmissivity, part of the leaving flux is stored as dead dislocation density. + !* That means for an interface of zero transmissivity the leaving flux is fully converted to dead dislocations. + + considerLeavingFlux = .true. + if (opposite_n > 0_pInt) then + if (phase_plasticity(material_phase(1,opposite_ip,opposite_el)) /= PLASTICITY_NONLOCAL_ID) & + considerLeavingFlux = .false. + endif + + if (considerLeavingFlux) then + + !* timeSyncing mode: If the central ip has zero subfraction, always use "state0". This is needed in case of + !* a synchronization step for the central ip, because then "state" contains the values at the end of the + !* previously converged full time step. Also, if either me or my neighbor has zero subfraction, we have to + !* use "state0" to make sure that fluxes on both sides of the (potential) timestep are equal. + my_rhoSgl = rhoSgl + my_v = v + if(numerics_timeSyncing) then + if (abs(subfrac(1_pInt,ip,el))<= tiny(0.0_pReal)) then + my_rhoSgl = rhoSgl0 + my_v = v0 + elseif (neighbor_n > 0_pInt) then + if (abs(subfrac(1_pInt,neighbor_ip,neighbor_el))<= tiny(0.0_pReal)) then + my_rhoSgl = rhoSgl0 + my_v = v0 + endif + endif + endif + + normal_me2neighbor_defConf = math_det33(Favg) & + * math_mul33x3(math_inv33(math_transpose33(Favg)), & + mesh_ipAreaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!) + normal_me2neighbor = math_mul33x3(math_transpose33(my_Fe), normal_me2neighbor_defConf) & + / math_det33(my_Fe) ! interface normal in my lattice configuration + area = mesh_ipArea(n,ip,el) * norm2(normal_me2neighbor) + normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length + do s = 1_pInt,ns + do t = 1_pInt,4_pInt + c = (t + 1_pInt) / 2_pInt + if (my_v(s,t) * math_mul3x3(m(1:3,s,t), normal_me2neighbor) > 0.0_pReal ) then ! flux from me to my neighbor == leaving flux for me (might also be a pure flux from my mobile density to dead density if interface not at all transmissive) + if (my_v(s,t) * neighbor_v(s,t) >= 0.0_pReal) then ! no sign change in flux density + transmissivity = sum(compatibility(c,1_pInt:ns,s,n,ip,el)**2.0_pReal) ! overall transmissivity from this slip system to my neighbor + else ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor + transmissivity = 0.0_pReal + endif + lineLength = my_rhoSgl(s,t) * my_v(s,t) & + * math_mul3x3(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface + rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / mesh_ipVolume(ip,el) ! subtract dislocation flux from current type + rhoDotFlux(s,t+4_pInt) = rhoDotFlux(s,t+4_pInt) & + + lineLength / mesh_ipVolume(ip,el) * (1.0_pReal - transmissivity) & + * sign(1.0_pReal, my_v(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point + endif + enddo + enddo + endif + + enddo ! neighbor loop +endif + + + +!**************************************************************************** +!*** calculate dipole formation and annihilation + +!*** formation by glide + +do c = 1_pInt,2_pInt + rhoDotSingle2DipoleGlide(1:ns,2*c-1) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile + + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile + + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) ! positive mobile --> negative immobile + + rhoDotSingle2DipoleGlide(1:ns,2*c) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile + + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile + + abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c))) ! negative mobile --> positive immobile + + rhoDotSingle2DipoleGlide(1:ns,2*c+3) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + * rhoSgl(1:ns,2*c+3) * abs(gdot(1:ns,2*c)) ! negative mobile --> positive immobile + + rhoDotSingle2DipoleGlide(1:ns,2*c+4) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + * rhoSgl(1:ns,2*c+4) * abs(gdot(1:ns,2*c-1)) ! positive mobile --> negative immobile + + rhoDotSingle2DipoleGlide(1:ns,c+8) = - rhoDotSingle2DipoleGlide(1:ns,2*c-1) & + - rhoDotSingle2DipoleGlide(1:ns,2*c) & + + abs(rhoDotSingle2DipoleGlide(1:ns,2*c+3)) & + + abs(rhoDotSingle2DipoleGlide(1:ns,2*c+4)) +enddo + + +!*** athermal annihilation + +rhoDotAthermalAnnihilation = 0.0_pReal + +forall (c=1_pInt:2_pInt) & + rhoDotAthermalAnnihilation(1:ns,c+8_pInt) = -2.0_pReal * dLower(1:ns,c) / burgers(1:ns,instance) & + * ( 2.0_pReal * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1))) & ! was single hitting single + + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single + + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent +! annihilated screw dipoles leave edge jogs behind on the colinear system +if (lattice_structure(ph) == LATTICE_fcc_ID) & ! only fcc + forall (s = 1:ns, colinearSystem(s,instance) > 0_pInt) & + rhoDotAthermalAnnihilation(colinearSystem(s,instance),1:2) = - rhoDotAthermalAnnihilation(s,10) & + * 0.25_pReal * sqrt(rhoForest(s)) * (dUpper(s,2) + dLower(s,2)) * edgeJogFactor(instance) + + + +!*** thermally activated annihilation of edge dipoles by climb + +rhoDotThermalAnnihilation = 0.0_pReal +selfDiffusion = Dsd0(instance) * exp(-selfDiffusionEnergy(instance) / (KB * Temperature)) +vClimb = atomicVolume(instance) * selfDiffusion / ( KB * Temperature ) & + * lattice_mu(ph) / ( 2.0_pReal * PI * (1.0_pReal-lattice_nu(ph)) ) & + * 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) ) +forall (s = 1_pInt:ns, dUpper(s,1) > dLower(s,1)) & + rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), & + - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & + - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have + + + +!**************************************************************************** +!*** assign the rates of dislocation densities to my dotState +!*** if evolution rates lead to negative densities, a cutback is enforced + +rhoDot = 0.0_pReal +rhoDot = rhoDotFlux & + + rhoDotMultiplication & + + rhoDotSingle2DipoleGlide & + + rhoDotAthermalAnnihilation & + + rhoDotThermalAnnihilation + +if (numerics_integrationMode == 1_pInt) then ! save rates for output if in central integration mode + rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8) + rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3]) + rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) + rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) + rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) + rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) +endif + + +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & + .and. ((debug_e == el .and. debug_i == ip .and. debug_g == 1_pInt)& + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then + write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', & + rhoDotMultiplication(1:ns,1:4) * timestep + write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', & + rhoDotFlux(1:ns,1:8) * timestep + write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by glide', & + rhoDotSingle2DipoleGlide * timestep + write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> athermal dipole annihilation', & + rhoDotAthermalAnnihilation * timestep + write(6,'(a,/,2(12x,12(e12.5,1x),/))') '<< CONST >> thermally activated dipole annihilation', & + rhoDotThermalAnnihilation(1:ns,9:10) * timestep + write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> total density change', & + rhoDot * timestep + write(6,'(a,/,10(12x,12(f12.5,1x),/))') '<< CONST >> relative density change', & + rhoDot(1:ns,1:8) * timestep / (abs(rhoSglOriginal)+1.0e-10), & + rhoDot(1:ns,9:10) * timestep / (rhoDipOriginal+1.0e-10) + write(6,*) + endif +#endif + + +if ( any(rhoSglOriginal(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < -aTolRho(instance)) & + .or. any(rhoDipOriginal(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < -aTolRho(instance))) then +#ifndef _OPENMP + if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then + write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip + write(6,'(a)') '<< CONST >> enforcing cutback !!!' + endif +#endif + plasticState(p)%dotState = DAMASK_NaN + return +else + forall (s = 1:ns, t = 1_pInt:4_pInt) + plasticState(p)%dotState(iRhoU(s,t,instance),o) = rhoDot(s,t) + plasticState(p)%dotState(iRhoB(s,t,instance),o) = rhoDot(s,t+4_pInt) + endforall + forall (s = 1:ns, c = 1_pInt:2_pInt) & + plasticState(p)%dotState(iRhoD(s,c,instance),o) = rhoDot(s,c+8_pInt) + forall (s = 1:ns) & + plasticState(p)%dotState(iGamma(s,instance),o) = sum(gdot(s,1:4)) +endif + +end subroutine plastic_nonlocal_dotState + + +!********************************************************************* +!* COMPATIBILITY UPDATE * +!* Compatibility is defined as normalized product of signed cosine * +!* of the angle between the slip plane normals and signed cosine of * +!* the angle between the slip directions. Only the largest values * +!* that sum up to a total of 1 are considered, all others are set to * +!* zero. * +!********************************************************************* +subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) + +use math, only: math_mul3x3, & + math_qRot +use material, only: material_phase, & + material_texture, & + phase_localPlasticity, & + phase_plasticityInstance, & + homogenization_maxNgrains +use mesh, only: mesh_element, & + mesh_ipNeighborhood, & + mesh_maxNips, & + mesh_NcpElems, & + FE_NipNeighbors, & + FE_geomtype, & + FE_celltype +use lattice, only: lattice_sn, & + lattice_sd, & + lattice_qDisorientation + +implicit none + +!* input variables +integer(pInt), intent(in) :: i, & ! ip index + e ! element index +real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + orientation ! crystal orientation in quaternions + +!* local variables +integer(pInt) Nneighbors, & ! number of neighbors + n, & ! neighbor index + neighbor_e, & ! element index of my neighbor + neighbor_i, & ! integration point index of my neighbor + ph, & + neighbor_phase, & + textureID, & + neighbor_textureID, & + instance, & ! instance of plasticity + ns, & ! number of active slip systems + s1, & ! slip system index (me) + s2 ! slip system index (my neighbor) +real(pReal), dimension(4) :: absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor +real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& + totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& + FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e))))) :: & + my_compatibility ! my_compatibility for current element and ip +real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & + slipNormal, & + slipDirection +real(pReal) my_compatibilitySum, & + thresholdValue, & + nThresholdValues +logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & + belowThreshold + + +Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) +ph = material_phase(1,i,e) +textureID = material_texture(1,i,e) +instance = phase_plasticityInstance(ph) +ns = totalNslip(instance) +slipNormal(1:3,1:ns) = lattice_sn(1:3, slipSystemLattice(1:ns,instance), ph) +slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) + + +!*** start out fully compatible + +my_compatibility = 0.0_pReal +forall(s1 = 1_pInt:ns) & + my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal + + +!*** Loop thrugh neighbors and check whether there is any my_compatibility. + +do n = 1_pInt,Nneighbors + neighbor_e = mesh_ipNeighborhood(1,n,i,e) + neighbor_i = mesh_ipNeighborhood(2,n,i,e) + + + !* FREE SURFACE + !* Set surface transmissivity to the value specified in the material.config + + if (neighbor_e <= 0_pInt .or. neighbor_i <= 0_pInt) then + forall(s1 = 1_pInt:ns) & + my_compatibility(1:2,s1,s1,n) = sqrt(surfaceTransmissivity(instance)) + cycle + endif + + + !* PHASE BOUNDARY + !* If we encounter a different nonlocal "cpfem" phase at the neighbor, + !* we consider this to be a real "physical" phase boundary, so completely incompatible. + !* If one of the two "CPFEM" phases has a local plasticity law, + !* we do not consider this to be a phase boundary, so completely compatible. + + neighbor_phase = material_phase(1,neighbor_i,neighbor_e) + if (neighbor_phase /= ph) then + if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph)) then + forall(s1 = 1_pInt:ns) & + my_compatibility(1:2,s1,s1,n) = 0.0_pReal ! = sqrt(0.0) + endif + cycle + endif + + + !* GRAIN BOUNDARY ! + !* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config) + + if (grainboundaryTransmissivity(instance) >= 0.0_pReal) then + neighbor_textureID = material_texture(1,neighbor_i,neighbor_e) + if (neighbor_textureID /= textureID) then + if (.not. phase_localPlasticity(neighbor_phase)) then + forall(s1 = 1_pInt:ns) & + my_compatibility(1:2,s1,s1,n) = sqrt(grainboundaryTransmissivity(instance)) + endif + cycle + endif + + + !* GRAIN BOUNDARY ? + !* Compatibility defined by relative orientation of slip systems: + !* The my_compatibility value is defined as the product of the slip normal projection and the slip direction projection. + !* Its sign is always positive for screws, for edges it has the same sign as the slip normal projection. + !* Since the sum for each slip system can easily exceed one (which would result in a transmissivity larger than one), + !* only values above or equal to a certain threshold value are considered. This threshold value is chosen, such that + !* the number of compatible slip systems is minimized with the sum of the original my_compatibility values exceeding one. + !* Finally the smallest my_compatibility value is decreased until the sum is exactly equal to one. + !* All values below the threshold are set to zero. + else + absoluteMisorientation = lattice_qDisorientation(orientation(1:4,1,i,e), & + orientation(1:4,1,neighbor_i,neighbor_e)) ! no symmetry + do s1 = 1_pInt,ns ! my slip systems + do s2 = 1_pInt,ns ! my neighbor's slip systems + my_compatibility(1,s2,s1,n) = math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2))) & + * abs(math_mul3x3(slipDirection(1:3,s1), math_qRot(absoluteMisorientation, slipDirection(1:3,s2)))) + my_compatibility(2,s2,s1,n) = abs(math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2)))) & + * abs(math_mul3x3(slipDirection(1:3,s1), math_qRot(absoluteMisorientation, slipDirection(1:3,s2)))) + enddo + + my_compatibilitySum = 0.0_pReal + belowThreshold = .true. + do while (my_compatibilitySum < 1.0_pReal .and. any(belowThreshold(1:ns))) + thresholdValue = maxval(my_compatibility(2,1:ns,s1,n), belowThreshold(1:ns)) ! screws always positive + nThresholdValues = real(count(my_compatibility(2,1:ns,s1,n) == thresholdValue),pReal) + where (my_compatibility(2,1:ns,s1,n) >= thresholdValue) & + belowThreshold(1:ns) = .false. + if (my_compatibilitySum + thresholdValue * nThresholdValues > 1.0_pReal) & + where (abs(my_compatibility(1:2,1:ns,s1,n)) == thresholdValue) & ! MD: rather check below threshold? + my_compatibility(1:2,1:ns,s1,n) = sign((1.0_pReal - my_compatibilitySum) & + / nThresholdValues, my_compatibility(1:2,1:ns,s1,n)) + my_compatibilitySum = my_compatibilitySum + nThresholdValues * thresholdValue + enddo + where (belowThreshold(1:ns)) my_compatibility(1,1:ns,s1,n) = 0.0_pReal + where (belowThreshold(1:ns)) my_compatibility(2,1:ns,s1,n) = 0.0_pReal + enddo ! my slip systems cycle + endif + +enddo ! neighbor cycle + +compatibility(1:2,1:ns,1:ns,1:Nneighbors,i,e) = my_compatibility + +end subroutine plastic_nonlocal_updateCompatibility + +!********************************************************************* +!* calculates quantities characterizing the microstructure * +!********************************************************************* +function plastic_nonlocal_dislocationstress(Fe, ip, el) +use math, only: math_mul33x33, & + math_mul33x3, & + math_inv33, & + math_transpose33, & + pi +use mesh, only: mesh_NcpElems, & + mesh_maxNips, & + mesh_element, & + mesh_node0, & + mesh_cellCenterCoordinates, & + mesh_ipVolume, & + mesh_periodicSurface, & + FE_Nips, & + FE_geomtype +use material, only: homogenization_maxNgrains, & + material_phase, & + plasticState, & + phaseAt, phasememberAt,& + phase_localPlasticity, & + phase_plasticityInstance +use lattice, only: lattice_mu, & + lattice_nu + +implicit none + +!*** input variables +integer(pInt), intent(in) :: ip, & !< current integration point + el !< current element +real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + Fe !< elastic deformation gradient + +!*** output variables +real(pReal), dimension(3,3) :: plastic_nonlocal_dislocationstress + +!*** local variables +integer(pInt) neighbor_el, & !< element number of neighbor material point + neighbor_ip, & !< integration point of neighbor material point + instance, & !< my instance of this plasticity + neighbor_instance, & !< instance of this plasticity of neighbor material point + ph, & + neighbor_phase, & + ns, & !< total number of active slip systems at my material point + neighbor_ns, & !< total number of active slip systems at neighbor material point + c, & !< index of dilsocation character (edge, screw) + s, & !< slip system index + o,& !< offset shortcut + no,& !< neighbour offset shortcut + p,& !< phase shortcut + np,& !< neighbour phase shortcut + t, & !< index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) + dir, & + deltaX, deltaY, deltaZ, & + side, & + j +integer(pInt), dimension(2,3) :: periodicImages +real(pReal) x, y, z, & !< coordinates of connection vector in neighbor lattice frame + xsquare, ysquare, zsquare, & !< squares of respective coordinates + distance, & !< length of connection vector + segmentLength, & !< segment length of dislocations + lambda, & + R, Rsquare, Rcube, & + denominator, & + flipSign, & + neighbor_ipVolumeSideLength +real(pReal), dimension(3) :: connection, & !< connection vector between me and my neighbor in the deformed configuration + connection_neighborLattice, & !< connection vector between me and my neighbor in the lattice configuration of my neighbor + connection_neighborSlip, & !< connection vector between me and my neighbor in the slip system frame of my neighbor + maxCoord, minCoord, & + meshSize, & + coords, & !< x,y,z coordinates of cell center of ip volume + neighbor_coords !< x,y,z coordinates of cell center of neighbor ip volume +real(pReal), dimension(3,3) :: sigma, & !< dislocation stress for one slip system in neighbor material point's slip system frame + Tdislo_neighborLattice, & !< dislocation stress as 2nd Piola-Kirchhoff stress at neighbor material point + invFe, & !< inverse of my elastic deformation gradient + neighbor_invFe, & + neighborLattice2myLattice !< mapping from neighbor MPs lattice configuration to my lattice configuration +real(pReal), dimension(2,2,maxval(totalNslip)) :: & + neighbor_rhoExcess !< excess density at neighbor material point (edge/screw,mobile/dead,slipsystem) +real(pReal), dimension(2,maxval(totalNslip)) :: & + rhoExcessDead +real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & + rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) + +ph = material_phase(1_pInt,ip,el) +instance = phase_plasticityInstance(ph) +ns = totalNslip(instance) +p = phaseAt(1,ip,el) +o = phasememberAt(1,ip,el) + +!*** get basic states + +forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) +endforall + + + +!*** calculate the dislocation stress of the neighboring excess dislocation densities +!*** zero for material points of local plasticity + +plastic_nonlocal_dislocationstress = 0.0_pReal + +if (.not. phase_localPlasticity(ph)) then + invFe = math_inv33(Fe(1:3,1:3,1_pInt,ip,el)) + + !* in case of periodic surfaces we have to find out how many periodic images in each direction we need + + do dir = 1_pInt,3_pInt + maxCoord(dir) = maxval(mesh_node0(dir,:)) + minCoord(dir) = minval(mesh_node0(dir,:)) + enddo + meshSize = maxCoord - minCoord + coords = mesh_cellCenterCoordinates(ip,el) + periodicImages = 0_pInt + do dir = 1_pInt,3_pInt + if (mesh_periodicSurface(dir)) then + periodicImages(1,dir) = floor((coords(dir) - cutoffRadius(instance) - minCoord(dir)) / meshSize(dir), pInt) + periodicImages(2,dir) = ceiling((coords(dir) + cutoffRadius(instance) - maxCoord(dir)) / meshSize(dir), pInt) + endif + enddo + + + !* loop through all material points (also through their periodic images if present), + !* but only consider nonlocal neighbors within a certain cutoff radius R + + do neighbor_el = 1_pInt,mesh_NcpElems + ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))) + neighbor_phase = material_phase(1_pInt,neighbor_ip,neighbor_el) + np = phaseAt(1,neighbor_ip,neighbor_el) + no = phasememberAt(1,neighbor_ip,neighbor_el) + + if (phase_localPlasticity(neighbor_phase)) cycle + neighbor_instance = phase_plasticityInstance(neighbor_phase) + neighbor_ns = totalNslip(neighbor_instance) + neighbor_invFe = math_inv33(Fe(1:3,1:3,1,neighbor_ip,neighbor_el)) + neighbor_ipVolumeSideLength = mesh_ipVolume(neighbor_ip,neighbor_el) ** (1.0_pReal/3.0_pReal) ! reference volume used here + + forall (s = 1_pInt:neighbor_ns, c = 1_pInt:2_pInt) + neighbor_rhoExcess(c,1,s) = plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no) & ! positive mobiles + - plasticState(np)%state(iRhoU(s,2*c,neighbor_instance),no) ! negative mobiles + neighbor_rhoExcess(c,2,s) = abs(plasticState(np)%state(iRhoB(s,2*c-1,neighbor_instance),no)) & ! positive deads + - abs(plasticState(np)%state(iRhoB(s,2*c,neighbor_instance),no)) ! negative deads + + endforall + Tdislo_neighborLattice = 0.0_pReal + do deltaX = periodicImages(1,1),periodicImages(2,1) + do deltaY = periodicImages(1,2),periodicImages(2,2) + do deltaZ = periodicImages(1,3),periodicImages(2,3) + + + !* regular case + + if (neighbor_el /= el .or. neighbor_ip /= ip & + .or. deltaX /= 0_pInt .or. deltaY /= 0_pInt .or. deltaZ /= 0_pInt) then + + neighbor_coords = mesh_cellCenterCoordinates(neighbor_ip,neighbor_el) & + + [real(deltaX,pReal), real(deltaY,pReal), real(deltaZ,pReal)] * meshSize + connection = neighbor_coords - coords + distance = sqrt(sum(connection * connection)) + if (distance > cutoffRadius(instance)) cycle + + + !* the segment length is the minimum of the third root of the control volume and the ip distance + !* this ensures, that the central MP never sits on a neighbor dislocation segment + + connection_neighborLattice = math_mul33x3(neighbor_invFe, connection) + segmentLength = min(neighbor_ipVolumeSideLength, distance) + + + !* loop through all slip systems of the neighbor material point + !* and add up the stress contributions from egde and screw excess on these slip systems (if significant) + + do s = 1_pInt,neighbor_ns + if (all(abs(neighbor_rhoExcess(:,:,s)) < significantRho(instance))) cycle ! not significant + + + !* map the connection vector from the lattice into the slip system frame + + connection_neighborSlip = math_mul33x3(lattice2slip(1:3,1:3,s,neighbor_instance), & + connection_neighborLattice) + + + !* edge contribution to stress + sigma = 0.0_pReal + + x = connection_neighborSlip(1) + y = connection_neighborSlip(2) + z = connection_neighborSlip(3) + xsquare = x * x + ysquare = y * y + zsquare = z * z + + do j = 1_pInt,2_pInt + if (abs(neighbor_rhoExcess(1,j,s)) < significantRho(instance)) then + cycle + elseif (j > 1_pInt) then + x = connection_neighborSlip(1) & + + sign(0.5_pReal * segmentLength, & + plasticState(np)%state(iRhoB(s,1,neighbor_instance),no) & + - plasticState(np)%state(iRhoB(s,2,neighbor_instance),no)) + + xsquare = x * x + endif + + flipSign = sign(1.0_pReal, -y) + do side = 1_pInt,-1_pInt,-2_pInt + lambda = real(side,pReal) * 0.5_pReal * segmentLength - y + R = sqrt(xsquare + zsquare + lambda * lambda) + Rsquare = R * R + Rcube = Rsquare * R + denominator = R * (R + flipSign * lambda) + if (abs(denominator)<= tiny(0.0_pReal)) exit ipLoop + + sigma(1,1) = sigma(1,1) - real(side,pReal) & + * flipSign * z / denominator & + * (1.0_pReal + xsquare / Rsquare + xsquare / denominator) & + * neighbor_rhoExcess(1,j,s) + sigma(2,2) = sigma(2,2) - real(side,pReal) & + * (flipSign * 2.0_pReal * lattice_nu(ph) * z / denominator + z * lambda / Rcube) & + * neighbor_rhoExcess(1,j,s) + sigma(3,3) = sigma(3,3) + real(side,pReal) & + * flipSign * z / denominator & + * (1.0_pReal - zsquare / Rsquare - zsquare / denominator) & + * neighbor_rhoExcess(1,j,s) + sigma(1,2) = sigma(1,2) + real(side,pReal) & + * x * z / Rcube * neighbor_rhoExcess(1,j,s) + sigma(1,3) = sigma(1,3) + real(side,pReal) & + * flipSign * x / denominator & + * (1.0_pReal - zsquare / Rsquare - zsquare / denominator) & + * neighbor_rhoExcess(1,j,s) + sigma(2,3) = sigma(2,3) - real(side,pReal) & + * (lattice_nu(ph) / R - zsquare / Rcube) * neighbor_rhoExcess(1,j,s) + enddo + enddo + + !* screw contribution to stress + + x = connection_neighborSlip(1) ! have to restore this value, because position might have been adapted for edge deads before + do j = 1_pInt,2_pInt + if (abs(neighbor_rhoExcess(2,j,s)) < significantRho(instance)) then + cycle + elseif (j > 1_pInt) then + y = connection_neighborSlip(2) & + + sign(0.5_pReal * segmentLength, & + plasticState(np)%state(iRhoB(s,3,neighbor_instance),no) & + - plasticState(np)%state(iRhoB(s,4,neighbor_instance),no)) + ysquare = y * y + endif + + flipSign = sign(1.0_pReal, x) + do side = 1_pInt,-1_pInt,-2_pInt + lambda = x + real(side,pReal) * 0.5_pReal * segmentLength + R = sqrt(ysquare + zsquare + lambda * lambda) + Rsquare = R * R + Rcube = Rsquare * R + denominator = R * (R + flipSign * lambda) + if (abs(denominator)<= tiny(0.0_pReal)) exit ipLoop + + sigma(1,2) = sigma(1,2) - real(side,pReal) * flipSign * z & + * (1.0_pReal - lattice_nu(ph)) / denominator & + * neighbor_rhoExcess(2,j,s) + sigma(1,3) = sigma(1,3) + real(side,pReal) * flipSign * y & + * (1.0_pReal - lattice_nu(ph)) / denominator & + * neighbor_rhoExcess(2,j,s) + enddo + enddo + + if (all(abs(sigma) < 1.0e-10_pReal)) cycle ! SIGMA IS NOT A REAL STRESS, THATS WHY WE NEED A REALLY SMALL VALUE HERE + + !* copy symmetric parts + + sigma(2,1) = sigma(1,2) + sigma(3,1) = sigma(1,3) + sigma(3,2) = sigma(2,3) + + + !* scale stresses and map them into the neighbor material point's lattice configuration + + sigma = sigma * lattice_mu(neighbor_phase) * burgers(s,neighbor_instance) & + / (4.0_pReal * pi * (1.0_pReal - lattice_nu(neighbor_phase))) & + * mesh_ipVolume(neighbor_ip,neighbor_el) / segmentLength ! reference volume is used here (according to the segment length calculation) + Tdislo_neighborLattice = Tdislo_neighborLattice & + + math_mul33x33(math_transpose33(lattice2slip(1:3,1:3,s,neighbor_instance)), & + math_mul33x33(sigma, lattice2slip(1:3,1:3,s,neighbor_instance))) + + enddo ! slip system loop + + + !* special case of central ip volume + !* only consider dead dislocations + !* we assume that they all sit at a distance equal to half the third root of V + !* in direction of the according slip direction + + else + + forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & + + rhoExcessDead(c,s) = plasticState(p)%state(iRhoB(s,2*c-1,instance),o) & ! positive deads (here we use symmetry: if this has negative sign it is + !treated as negative density at positive position instead of positive + !density at negative position) + + plasticState(p)%state(iRhoB(s,2*c,instance),o) ! negative deads (here we use symmetry: if this has negative sign it is + !treated as positive density at positive position instead of negative + !density at negative position) + do s = 1_pInt,ns + if (all(abs(rhoExcessDead(:,s)) < significantRho(instance))) cycle ! not significant + sigma = 0.0_pReal ! all components except for sigma13 are zero + sigma(1,3) = - (rhoExcessDead(1,s) + rhoExcessDead(2,s) * (1.0_pReal - lattice_nu(ph))) & + * neighbor_ipVolumeSideLength * lattice_mu(ph) * burgers(s,instance) & + / (sqrt(2.0_pReal) * pi * (1.0_pReal - lattice_nu(ph))) + sigma(3,1) = sigma(1,3) + + Tdislo_neighborLattice = Tdislo_neighborLattice & + + math_mul33x33(math_transpose33(lattice2slip(1:3,1:3,s,instance)), & + math_mul33x33(sigma, lattice2slip(1:3,1:3,s,instance))) + + enddo ! slip system loop + + endif + + enddo ! deltaZ loop + enddo ! deltaY loop + enddo ! deltaX loop + + + !* map the stress from the neighbor MP's lattice configuration into the deformed configuration + !* and back into my lattice configuration + + neighborLattice2myLattice = math_mul33x33(invFe, Fe(1:3,1:3,1,neighbor_ip,neighbor_el)) + plastic_nonlocal_dislocationstress = plastic_nonlocal_dislocationstress & + + math_mul33x33(neighborLattice2myLattice, & + math_mul33x33(Tdislo_neighborLattice, & + math_transpose33(neighborLattice2myLattice))) + + enddo ipLoop + enddo ! element loop + +endif + +end function plastic_nonlocal_dislocationstress + + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) + use math, only: & + math_mul6x6, & + math_mul33x3, & + math_mul33x33, & + pi + use mesh, only: & + mesh_NcpElems, & + mesh_maxNips + use material, only: & + homogenization_maxNgrains, & + material_phase, & + phaseAt, phasememberAt, & + plasticState, & + phase_plasticityInstance + use lattice, only: & + lattice_Sslip_v, & + lattice_sd, & + lattice_st, & + lattice_sn, & + lattice_mu, & + lattice_nu + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + Fe !< elastic deformation gradient + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element + + real(pReal), dimension(plastic_nonlocal_sizePostResults(& + phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + plastic_nonlocal_postResults + + integer(pInt) :: & + ph, & + instance, & !< current instance of this plasticity + ns, & !< short notation for the total number of active slip systems + c, & !< character of dislocation + cs, & !< constitutive result index + o, & !< index of current output + of,& !< offset shortcut + t, & !< type of dislocation + s, & !< index of my current slip system + sLattice !< index of my current slip system according to lattice order + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & + rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) + rhoDotSgl !< evolution rate of single dislocation densities (positive/negative screw and edge without dipoles) + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & + gdot, & !< shear rates + v !< velocities + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + rhoForest, & !< forest dislocation density + tauThreshold, & !< threshold shear stress + tau, & !< current resolved shear stress + tauBack !< back stress from pileups on same slip system + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & + rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) + rhoDotDip, & !< evolution rate of dipole dislocation densities (screw and edge dipoles) + dLower, & !< minimum stable dipole distance for edges and screws + dUpper !< current maximum stable dipole distance for edges and screws + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & + m, & !< direction of dislocation motion for edge and screw (unit vector) + m_currentconf !< direction of dislocation motion for edge and screw (unit vector) in current configuration + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + n_currentconf !< slip system normal (unit vector) in current configuration + real(pReal), dimension(3,3) :: & + sigma + +ph = phaseAt(1,ip,el) +of = phasememberAt(1,ip,el) +instance = phase_plasticityInstance(ph) +ns = totalNslip(instance) + +cs = 0_pInt +plastic_nonlocal_postResults = 0.0_pReal + + +!* short hand notations for state variables + +forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) + rhoSgl(s,t) = plasticState(ph)%State(iRhoU(s,t,instance),of) + rhoSgl(s,t+4_pInt) = plasticState(ph)%State(iRhoB(s,t,instance),of) + v(s,t) = plasticState(ph)%State(iV(s,t,instance),of) + rhoDotSgl(s,t) = plasticState(ph)%dotState(iRhoU(s,t,instance),of) + rhoDotSgl(s,t+4_pInt) = plasticState(ph)%dotState(iRhoB(s,t,instance),of) +endforall +forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) + rhoDip(s,c) = plasticState(ph)%State(iRhoD(s,c,instance),of) + rhoDotDip(s,c) = plasticState(ph)%dotState(iRhoD(s,c,instance),of) +endforall +rhoForest = plasticState(ph)%State(iRhoF(1:ns,instance),of) +tauThreshold = plasticState(ph)%State(iTauF(1:ns,instance),of) +tauBack = plasticState(ph)%State(iTauB(1:ns,instance),of) + +!* Calculate shear rate + +forall (t = 1_pInt:4_pInt) & + gdot(1:ns,t) = rhoSgl(1:ns,t) * burgers(1:ns,instance) * v(1:ns,t) + + +!* calculate limits for stable dipole height + +do s = 1_pInt,ns + sLattice = slipSystemLattice(s,instance) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) + if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal +enddo + +dLower = minDipoleHeight(1:ns,1:2,instance) +dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) & + / (4.0_pReal * pi * abs(tau)) +forall (c = 1_pInt:2_pInt) + where(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+& + abs(rhoSgl(1:ns,2*c+3))+abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)) >= tiny(0.0_pReal)) & + dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & + dUpper(1:ns,c)) +end forall +dUpper = max(dUpper,dLower) + + +!*** dislocation motion + +m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),ph) +m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),ph) +forall (c = 1_pInt:2_pInt, s = 1_pInt:ns) & + m_currentconf(1:3,s,c) = math_mul33x3(Fe(1:3,1:3,1_pInt,ip,el), m(1:3,s,c)) +forall (s = 1_pInt:ns) & + n_currentconf(1:3,s) = math_mul33x3(Fe(1:3,1:3,1_pInt,ip,el), & + lattice_sn(1:3,slipSystemLattice(s,instance),ph)) + + +outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) + select case(plastic_nonlocal_outputID(o,instance)) + case (rho_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) + sum(rhoDip,2) + cs = cs + ns + + case (rho_sgl_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) + cs = cs + ns + + case (rho_sgl_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,1:4)),2) + cs = cs + ns + + case (rho_sgl_immobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:8),2) + cs = cs + ns + + case (rho_dip_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDip,2) + cs = cs + ns + + case (rho_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1) + cs = cs + ns + + case (rho_sgl_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + cs = cs + ns + + case (rho_sgl_edge_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,1:2),2) + cs = cs + ns + + case (rho_sgl_edge_immobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:6),2) + cs = cs + ns + + case (rho_sgl_edge_pos_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5)) + cs = cs + ns + + case (rho_sgl_edge_pos_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + cs = cs + ns + + case (rho_sgl_edge_pos_immobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5) + cs = cs + ns + + case (rho_sgl_edge_neg_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6)) + cs = cs + ns + + case (rho_sgl_edge_neg_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + cs = cs + ns + + case (rho_sgl_edge_neg_immobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,6) + cs = cs + ns + + case (rho_dip_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1) + cs = cs + ns + + case (rho_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2) + cs = cs + ns + + case (rho_sgl_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + cs = cs + ns + + case (rho_sgl_screw_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,3:4),2) + cs = cs + ns + + case (rho_sgl_screw_immobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,7:8),2) + cs = cs + ns + + case (rho_sgl_screw_pos_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7)) + cs = cs + ns + + case (rho_sgl_screw_pos_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + cs = cs + ns + + case (rho_sgl_screw_pos_immobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7) + cs = cs + ns + + case (rho_sgl_screw_neg_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)) + cs = cs + ns + + case (rho_sgl_screw_neg_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + cs = cs + ns + + case (rho_sgl_screw_neg_immobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,8) + cs = cs + ns + + case (rho_dip_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2) + cs = cs + ns + + case (excess_rho_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & + - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) & + + (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & + - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) + cs = cs + ns + + case (excess_rho_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & + - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) + cs = cs + ns + + case (excess_rho_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & + - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) + cs = cs + ns + + case (rho_forest_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoForest + cs = cs + ns + + case (delta_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2) + sum(rhoDip,2)) + cs = cs + ns + + case (delta_sgl_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2)) + cs = cs + ns + + case (delta_dip_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(rhoDip,2)) + cs = cs + ns + + case (shearrate_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(gdot,2) + cs = cs + ns + + case (resolvedstress_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tau + cs = cs + ns + + case (resolvedstress_back_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauBack + cs = cs + ns + + case (resolvedstress_external_ID) + do s = 1_pInt,ns + sLattice = slipSystemLattice(s,instance) + plastic_nonlocal_postResults(cs+s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + enddo + cs = cs + ns + + case (resistance_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauThreshold + cs = cs + ns + + case (rho_dot_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & + + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) & + + sum(rhoDotDip,2) + cs = cs + ns + + case (rho_dot_sgl_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & + + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) + cs = cs + ns + + case (rho_dot_sgl_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) + cs = cs + ns + + case (rho_dot_dip_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) + cs = cs + ns + + case (rho_dot_gen_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_gen_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_gen_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_sgl2dip_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_sgl2dip_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_sgl2dip_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_ann_ath_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_ann_the_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_ann_the_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_ann_the_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_edgejogs_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) + cs = cs + ns + + case (rho_dot_flux_mobile_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) + cs = cs + ns + + case (rho_dot_flux_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) & + + sum(rhoDotFluxOutput(1:ns,5:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) + cs = cs + ns + + case (rho_dot_flux_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) & + + sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) + cs = cs + ns + + case (rho_dot_flux_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,3:4,1_pInt,ip,el),2) & + + sum(rhoDotFluxOutput(1:ns,7:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) + cs = cs + ns + + case (velocity_edge_pos_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,1) + cs = cs + ns + + case (velocity_edge_neg_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,2) + cs = cs + ns + + case (velocity_screw_pos_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,3) + cs = cs + ns + + case (velocity_screw_neg_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,4) + cs = cs + ns + + case (slipdirectionx_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(1,1:ns,1) + cs = cs + ns + + case (slipdirectiony_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(2,1:ns,1) + cs = cs + ns + + case (slipdirectionz_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(3,1:ns,1) + cs = cs + ns + + case (slipnormalx_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(1,1:ns) + cs = cs + ns + + case (slipnormaly_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(2,1:ns) + cs = cs + ns + + case (slipnormalz_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(3,1:ns) + cs = cs + ns + + case (fluxdensity_edge_posx_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(1,1:ns,1) + cs = cs + ns + + case (fluxdensity_edge_posy_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(2,1:ns,1) + cs = cs + ns + + case (fluxdensity_edge_posz_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(3,1:ns,1) + cs = cs + ns + + case (fluxdensity_edge_negx_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(1,1:ns,1) + cs = cs + ns + + case (fluxdensity_edge_negy_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(2,1:ns,1) + cs = cs + ns + + case (fluxdensity_edge_negz_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(3,1:ns,1) + cs = cs + ns + + case (fluxdensity_screw_posx_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(1,1:ns,2) + cs = cs + ns + + case (fluxdensity_screw_posy_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(2,1:ns,2) + cs = cs + ns + + case (fluxdensity_screw_posz_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(3,1:ns,2) + cs = cs + ns + + case (fluxdensity_screw_negx_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(1,1:ns,2) + cs = cs + ns + + case (fluxdensity_screw_negy_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(2,1:ns,2) + cs = cs + ns + + case (fluxdensity_screw_negz_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(3,1:ns,2) + cs = cs + ns + + case (maximumdipoleheight_edge_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1) + cs = cs + ns + + case (maximumdipoleheight_screw_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2) + cs = cs + ns + + case(dislocationstress_ID) + sigma = plastic_nonlocal_dislocationstress(Fe, ip, el) + plastic_nonlocal_postResults(cs+1_pInt) = sigma(1,1) + plastic_nonlocal_postResults(cs+2_pInt) = sigma(2,2) + plastic_nonlocal_postResults(cs+3_pInt) = sigma(3,3) + plastic_nonlocal_postResults(cs+4_pInt) = sigma(1,2) + plastic_nonlocal_postResults(cs+5_pInt) = sigma(2,3) + plastic_nonlocal_postResults(cs+6_pInt) = sigma(3,1) + cs = cs + 6_pInt + + case(accumulatedshear_ID) + plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of) + cs = cs + ns + + end select +enddo outputsLoop + +end function plastic_nonlocal_postResults + +end module plastic_nonlocal diff --git a/code/plastic/plastic_phenoplus.f90 b/code/plastic/plastic_phenoplus.f90 new file mode 100644 index 000000000..0a40edd84 --- /dev/null +++ b/code/plastic/plastic_phenoplus.f90 @@ -0,0 +1,1419 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Chen Zhang, Michigan State University +!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw +!... fitting +!-------------------------------------------------------------------------------------------------- +module plastic_phenoplus + use prec, only: & + pReal,& + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_phenoplus_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_phenoplus_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_phenoplus_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_phenoplus_Noutput !< number of outputs per instance of this constitution + + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_phenoplus_totalNslip, & !< no. of slip system used in simulation + plastic_phenoplus_totalNtwin, & !< no. of twin system used in simulation + plastic_phenoplus_totalNtrans !< no. of trans system used in simulation + + integer(pInt), dimension(:,:), allocatable, private :: & + plastic_phenoplus_Nslip, & !< active number of slip systems per family (input parameter, per family) + plastic_phenoplus_Ntwin, & !< active number of twin systems per family (input parameter, per family) + plastic_phenoplus_Ntrans !< active number of trans systems per family (input parameter, per family) + + real(pReal), dimension(:), allocatable, private :: & + plastic_phenoplus_gdot0_slip, & !< reference shear strain rate for slip (input parameter) + plastic_phenoplus_gdot0_twin, & !< reference shear strain rate for twin (input parameter) + plastic_phenoplus_n_slip, & !< stress exponent for slip (input parameter) + plastic_phenoplus_n_twin, & !< stress exponent for twin (input parameter) + plastic_phenoplus_spr, & !< push-up factor for slip saturation due to twinning + plastic_phenoplus_twinB, & + plastic_phenoplus_twinC, & + plastic_phenoplus_twinD, & + plastic_phenoplus_twinE, & + plastic_phenoplus_h0_SlipSlip, & !< reference hardening slip - slip (input parameter) + plastic_phenoplus_h0_TwinSlip, & !< reference hardening twin - slip (input parameter) + plastic_phenoplus_h0_TwinTwin, & !< reference hardening twin - twin (input parameter) + plastic_phenoplus_a_slip, & + plastic_phenoplus_aTolResistance, & + plastic_phenoplus_aTolShear, & + plastic_phenoplus_aTolTwinfrac, & + plastic_phenoplus_aTolTransfrac, & + plastic_phenoplus_Cnuc, & !< coefficient for strain-induced martensite nucleation + plastic_phenoplus_Cdwp, & !< coefficient for double well potential + plastic_phenoplus_Cgro, & !< coefficient for stress-assisted martensite growth + plastic_phenoplus_deltaG, & !< free energy difference between austensite and martensite [MPa] + plastic_phenoplus_kappa_max !< capped kappa for each slip system + + real(pReal), dimension(:,:), allocatable, private :: & + plastic_phenoplus_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) + plastic_phenoplus_tau0_twin, & !< initial critical shear stress for twin (input parameter, per family) + plastic_phenoplus_tausat_slip, & !< maximum critical shear stress for slip (input parameter, per family) + plastic_phenoplus_nonSchmidCoeff, & + + plastic_phenoplus_interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) + plastic_phenoplus_interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) + plastic_phenoplus_interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) + plastic_phenoplus_interaction_TwinTwin !< interaction factors twin - twin (input parameter) + + real(pReal), dimension(:,:,:), allocatable, private :: & + plastic_phenoplus_hardeningMatrix_SlipSlip, & + plastic_phenoplus_hardeningMatrix_SlipTwin, & + plastic_phenoplus_hardeningMatrix_TwinSlip, & + plastic_phenoplus_hardeningMatrix_TwinTwin + + enum, bind(c) + enumerator :: undefined_ID, & + resistance_slip_ID, & + accumulatedshear_slip_ID, & + shearrate_slip_ID, & + resolvedstress_slip_ID, & + kappa_slip_ID, & + totalshear_ID, & + resistance_twin_ID, & + accumulatedshear_twin_ID, & + shearrate_twin_ID, & + resolvedstress_twin_ID, & + totalvolfrac_twin_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_phenoplus_outputID !< ID of each post result output + + public :: & + plastic_phenoplus_init, & + plastic_phenoplus_microstructure, & + plastic_phenoplus_LpAndItsTangent, & + plastic_phenoplus_dotState, & + plastic_phenoplus_postResults + private :: & + plastic_phenoplus_aTolState, & + plastic_phenoplus_stateInit + + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenoplus_init(fileUnit) + 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 + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_PHENOPLUS_label, & + PLASTICITY_PHENOPLUS_ID, & + material_phase, & + plasticState, & + MATERIAL_partPhase + use lattice + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + maxNinstance, & + instance,phase,j,k, f,o, & + Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & + Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & + Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & + Nchunks_TransFamilies = 0_pInt, Nchunks_nonSchmid = 0_pInt, & + NipcMyPhase, & + offset_slip, index_myFamily, index_otherFamily, & + mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState + character(len=65536) :: & + tag = '', & + line = '' + real(pReal), dimension(:), allocatable :: tempPerSlip + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPLUS_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPLUS_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(plastic_phenoplus_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_phenoplus_sizePostResult(maxval(phase_Noutput),maxNinstance), & + source=0_pInt) + allocate(plastic_phenoplus_output(maxval(phase_Noutput),maxNinstance)) + plastic_phenoplus_output = '' + allocate(plastic_phenoplus_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) + allocate(plastic_phenoplus_Noutput(maxNinstance), source=0_pInt) + allocate(plastic_phenoplus_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(plastic_phenoplus_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) + allocate(plastic_phenoplus_Ntrans(lattice_maxNtransFamily,maxNinstance),source=0_pInt) + allocate(plastic_phenoplus_totalNslip(maxNinstance), source=0_pInt) + allocate(plastic_phenoplus_totalNtwin(maxNinstance), source=0_pInt) + allocate(plastic_phenoplus_totalNtrans(maxNinstance), source=0_pInt) + allocate(plastic_phenoplus_gdot0_slip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_n_slip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_tau0_slip(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_tausat_slip(lattice_maxNslipFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_gdot0_twin(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_n_twin(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_tau0_twin(lattice_maxNtwinFamily,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_spr(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_twinB(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_twinC(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_twinD(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_twinE(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_h0_SlipSlip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_h0_TwinSlip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_h0_TwinTwin(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_a_slip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_aTolResistance(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_aTolShear(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_aTolTwinfrac(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_aTolTransfrac(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenoplus_Cnuc(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_Cdwp(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_Cgro(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_deltaG(maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_kappa_max(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_PHENOPLUS_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase + Nchunks_TransFamilies = count(lattice_NtransSystem(:,phase) > 0_pInt) ! maximum number of trans families according to lattice type of current phase + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + Nchunks_nonSchmid = lattice_NnonSchmid(phase) + if(allocated(tempPerSlip)) deallocate(tempPerSlip) + allocate(tempPerSlip(Nchunks_SlipFamilies)) + endif + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPLUS_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('resistance_slip') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resistance_slip_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_slip','accumulated_shear_slip') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = accumulatedshear_slip_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_slip') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = shearrate_slip_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_slip') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resolvedstress_slip_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('kappa_slip') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = kappa_slip_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalshear') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = totalshear_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resistance_twin') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resistance_twin_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_twin','accumulated_shear_twin') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = accumulatedshear_twin_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_twin') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = shearrate_twin_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_twin') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resolvedstress_twin_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalvolfrac_twin') + plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt + plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = totalvolfrac_twin_ID + plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case default + + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of slip families + case ('nslip') + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + do j = 1_pInt, Nchunks_SlipFamilies + plastic_phenoplus_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('tausat_slip','tau0_slip') + tempPerSlip = 0.0_pReal + do j = 1_pInt, Nchunks_SlipFamilies + if (plastic_phenoplus_Nslip(j,instance) > 0_pInt) & + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('tausat_slip') + plastic_phenoplus_tausat_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('tau0_slip') + plastic_phenoplus_tau0_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of twin families + case ('ntwin') + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_TwinFamilies + plastic_phenoplus_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('tau0_twin') + do j = 1_pInt, Nchunks_TwinFamilies + if (plastic_phenoplus_Ntwin(j,instance) > 0_pInt) & + plastic_phenoplus_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of transformation families + case ('ntrans') + if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + Nchunks_TransFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_TransFamilies + plastic_phenoplus_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of interactions + case ('interaction_slipslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + do j = 1_pInt, Nchunks_SlipSlip + plastic_phenoplus_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_sliptwin') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + do j = 1_pInt, Nchunks_SlipTwin + plastic_phenoplus_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twinslip') + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + do j = 1_pInt, Nchunks_TwinSlip + plastic_phenoplus_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twintwin') + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + do j = 1_pInt, Nchunks_TwinTwin + plastic_phenoplus_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('nonschmid_coefficients') + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') + do j = 1_pInt,Nchunks_nonSchmid + plastic_phenoplus_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters independent of number of slip/twin systems + case ('gdot0_slip') + plastic_phenoplus_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('n_slip') + plastic_phenoplus_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('a_slip', 'w0_slip') + plastic_phenoplus_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('gdot0_twin') + plastic_phenoplus_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('n_twin') + plastic_phenoplus_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('s_pr') + plastic_phenoplus_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_b') + plastic_phenoplus_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_c') + plastic_phenoplus_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_d') + plastic_phenoplus_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_e') + plastic_phenoplus_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('h0_slipslip') + plastic_phenoplus_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('h0_twinslip') + plastic_phenoplus_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('h0_twintwin') + plastic_phenoplus_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_resistance') + plastic_phenoplus_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_shear') + plastic_phenoplus_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_twinfrac') + plastic_phenoplus_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_transfrac') + plastic_phenoplus_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('kappa_max') + plastic_phenoplus_kappa_max(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cnuc') + plastic_phenoplus_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cdwp') + plastic_phenoplus_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cgro') + plastic_phenoplus_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('deltag') + plastic_phenoplus_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) + case default + + end select + endif; endif + enddo parsingFile + + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_phenoplus_ID) then + instance = phase_plasticityInstance(phase) + plastic_phenoplus_Nslip(1:lattice_maxNslipFamily,instance) = & + min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested + plastic_phenoplus_Nslip(1:lattice_maxNslipFamily,instance)) + plastic_phenoplus_Ntwin(1:lattice_maxNtwinFamily,instance) = & + min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,phase),& ! limit active twin systems per family to min of available and requested + plastic_phenoplus_Ntwin(:,instance)) + plastic_phenoplus_totalNslip(instance) = sum(plastic_phenoplus_Nslip(:,instance)) ! how many slip systems altogether + plastic_phenoplus_totalNtwin(instance) = sum(plastic_phenoplus_Ntwin(:,instance)) ! how many twin systems altogether + plastic_phenoplus_totalNtrans(instance) = sum(plastic_phenoplus_Ntrans(:,instance)) ! how many trans systems altogether + + if (any(plastic_phenoplus_tau0_slip(:,instance) < 0.0_pReal .and. & + plastic_phenoplus_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPLUS_label//')') + if (plastic_phenoplus_gdot0_slip(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPLUS_label//')') + if (plastic_phenoplus_n_slip(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPLUS_label//')') + if (any(plastic_phenoplus_tausat_slip(:,instance) <= 0.0_pReal .and. & + plastic_phenoplus_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPLUS_label//')') + if (any(abs(plastic_phenoplus_a_slip(instance)) <= tiny(0.0_pReal) .and. & + plastic_phenoplus_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPLUS_label//')') + if (any(plastic_phenoplus_tau0_twin(:,instance) < 0.0_pReal .and. & + plastic_phenoplus_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPLUS_label//')') + if ( plastic_phenoplus_gdot0_twin(instance) <= 0.0_pReal .and. & + any(plastic_phenoplus_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPLUS_label//')') + if ( plastic_phenoplus_n_twin(instance) <= 0.0_pReal .and. & + any(plastic_phenoplus_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPLUS_label//')') + if (plastic_phenoplus_aTolResistance(instance) <= 0.0_pReal) & + plastic_phenoplus_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa + if (plastic_phenoplus_aTolShear(instance) <= 0.0_pReal) & + plastic_phenoplus_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (plastic_phenoplus_aTolTwinfrac(instance) <= 0.0_pReal) & + plastic_phenoplus_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (plastic_phenoplus_aTolTransfrac(instance) <= 0.0_pReal) & + plastic_phenoplus_aTolTransfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + endif myPhase + enddo sanityChecks + +!-------------------------------------------------------------------------------------------------- +! allocation of variables whose size depends on the total number of active slip systems + allocate(plastic_phenoplus_hardeningMatrix_SlipSlip(maxval(plastic_phenoplus_totalNslip),& ! slip resistance from slip activity + maxval(plastic_phenoplus_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_hardeningMatrix_SlipTwin(maxval(plastic_phenoplus_totalNslip),& ! slip resistance from twin activity + maxval(plastic_phenoplus_totalNtwin),& + maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_hardeningMatrix_TwinSlip(maxval(plastic_phenoplus_totalNtwin),& ! twin resistance from slip activity + maxval(plastic_phenoplus_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_phenoplus_hardeningMatrix_TwinTwin(maxval(plastic_phenoplus_totalNtwin),& ! twin resistance from twin activity + maxval(plastic_phenoplus_totalNtwin),& + maxNinstance), source=0.0_pReal) + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config + myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenoplus_ID) then ! only consider my phase + NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase + instance = phase_plasticityInstance(phase) ! which instance of my phase + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,plastic_phenoplus_Noutput(instance) + select case(plastic_phenoplus_outputID(o,instance)) + case(resistance_slip_ID, & + shearrate_slip_ID, & + accumulatedshear_slip_ID, & + resolvedstress_slip_ID, & + kappa_slip_ID & + ) + mySize = plastic_phenoplus_totalNslip(instance) + case(resistance_twin_ID, & + shearrate_twin_ID, & + accumulatedshear_twin_ID, & + resolvedstress_twin_ID & + ) + mySize = plastic_phenoplus_totalNtwin(instance) + case(totalshear_ID, & + totalvolfrac_twin_ID & + ) + mySize = 1_pInt + case default + end select + + outputFound: if (mySize > 0_pInt) then + plastic_phenoplus_sizePostResult(o,instance) = mySize + plastic_phenoplus_sizePostResults(instance) = plastic_phenoplus_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + sizeState = plastic_phenoplus_totalNslip(instance) & ! s_slip + + plastic_phenoplus_totalNtwin(instance) & ! s_twin + + 2_pInt & ! sum(gamma) + sum(f) + + plastic_phenoplus_totalNslip(instance) & ! accshear_slip + + plastic_phenoplus_totalNtwin(instance) & ! accshear_twin + + plastic_phenoplus_totalNslip(instance) ! kappa + + !sizeDotState = sizeState ! same as sizeState + !QUICK FIX: the dotState cannot have redundancy, which could cause unknown error + ! explicitly specify the size of the dotState to avoid this potential + ! memory leak issue. + sizeDotState = plastic_phenoplus_totalNslip(instance) & ! s_slip + + plastic_phenoplus_totalNtwin(instance) & ! s_twin + + 2_pInt & ! sum(gamma) + sum(f) + + plastic_phenoplus_totalNslip(instance) & ! accshear_slip + + plastic_phenoplus_totalNtwin(instance) ! accshear_twin + + sizeDeltaState = 0_pInt + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_phenoplus_sizePostResults(instance) + plasticState(phase)%nSlip =plastic_phenoplus_totalNslip(instance) + plasticState(phase)%nTwin =plastic_phenoplus_totalNtwin(instance) + plasticState(phase)%nTrans=plastic_phenoplus_totalNtrans(instance) + allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) + allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup ( sizeState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) + + offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + + do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X + index_myFamily = sum(plastic_phenoplus_Nslip(1:f-1_pInt,instance)) + do j = 1_pInt,plastic_phenoplus_Nslip(f,instance) ! loop over (active) systems in my family (slip) + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_phenoplus_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenoplus_Nslip(o,instance) ! loop over (active) systems in other family (slip) + plastic_phenoplus_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenoplus_interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_phenoplus_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenoplus_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + plastic_phenoplus_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenoplus_interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo; enddo + + do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X + index_myFamily = sum(plastic_phenoplus_Ntwin(1:f-1_pInt,instance)) + do j = 1_pInt,plastic_phenoplus_Ntwin(f,instance) ! loop over (active) systems in my family (twin) + + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_phenoplus_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenoplus_Nslip(o,instance) ! loop over (active) systems in other family (slip) + plastic_phenoplus_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenoplus_interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_phenoplus_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenoplus_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + plastic_phenoplus_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenoplus_interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo; enddo + + call plastic_phenoplus_stateInit(phase,instance) + call plastic_phenoplus_aTolState(phase,instance) + endif myPhase2 + enddo initializeInstances + +end subroutine plastic_phenoplus_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the initial microstructural state for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenoplus_stateInit(ph,instance) + use lattice, only: & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + integer(pInt) :: & + i + real(pReal), dimension(plasticState(ph)%sizeState) :: & + tempState + + tempState = 0.0_pReal + do i = 1_pInt,lattice_maxNslipFamily + tempState(1+sum(plastic_phenoplus_Nslip(1:i-1,instance)) : & + sum(plastic_phenoplus_Nslip(1:i ,instance))) = & + plastic_phenoplus_tau0_slip(i,instance) + enddo + + do i = 1_pInt,lattice_maxNtwinFamily + tempState(1+sum(plastic_phenoplus_Nslip(:,instance))+& + sum(plastic_phenoplus_Ntwin(1:i-1,instance)) : & + sum(plastic_phenoplus_Nslip(:,instance))+& + sum(plastic_phenoplus_Ntwin(1:i ,instance))) = & + plastic_phenoplus_tau0_twin(i,instance) + enddo + + plasticState(ph)%state0(:,:) = spread(tempState, & ! spread single tempstate array + 2, & ! along dimension 2 + size(plasticState(ph)%state0(1,:))) ! number of copies (number of IPCs) + +end subroutine plastic_phenoplus_stateInit + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the relevant state values for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenoplus_aTolState(ph,instance) + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + + plasticState(ph)%aTolState(1:plastic_phenoplus_totalNslip(instance)+ & + plastic_phenoplus_totalNtwin(instance)) = & + plastic_phenoplus_aTolResistance(instance) + plasticState(ph)%aTolState(1+plastic_phenoplus_totalNslip(instance)+ & + plastic_phenoplus_totalNtwin(instance)) = & + plastic_phenoplus_aTolShear(instance) + plasticState(ph)%aTolState(2+plastic_phenoplus_totalNslip(instance)+ & + plastic_phenoplus_totalNtwin(instance)) = & + plastic_phenoplus_aTolTwinFrac(instance) + plasticState(ph)%aTolState(3+plastic_phenoplus_totalNslip(instance)+ & + plastic_phenoplus_totalNtwin(instance): & + 2+2*(plastic_phenoplus_totalNslip(instance)+ & + plastic_phenoplus_totalNtwin(instance))) = & + plastic_phenoplus_aTolShear(instance) + +end subroutine plastic_phenoplus_aTolState + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculate push-up factors (kappa) for each voxel based on its neighbors +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenoplus_microstructure(orientation,ipc,ip,el) + use math, only: pi, & + math_mul33x33, & + math_mul3x3, & + math_transpose33, & + math_qDot, & + math_qRot, & + indeg + + use mesh, only: mesh_element, & + FE_NipNeighbors, & + FE_geomtype, & + FE_celltype, & + mesh_maxNips, & + mesh_NcpElems, & + mesh_ipNeighborhood + + use material, only: material_phase, & + material_texture, & + phase_plasticityInstance, & + phaseAt, phasememberAt, & + homogenization_maxNgrains, & + plasticState + + use lattice, only: lattice_sn, & + lattice_sd, & + lattice_qDisorientation + + !***input variables + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + orientation ! crystal orientation in quaternions + + !***local variables + integer(pInt) instance, & !my instance of this plasticity + ph, & !my phase + of, & !my spatial position in memory (offset) + textureID, & !my texture + Nneighbors, & !number of neighbors (<= 6) + vld_Nneighbors, & !number of my valid neighbors + n, & !neighbor index (for iterating through all neighbors) + ns, & !number of slip system + nt, & !number of twin system + me_slip, & !my slip system index + neighbor_el, & !element number of neighboring material point + neighbor_ip, & !integration point of neighboring material point + neighbor_n, & !I have no idea what is this + neighbor_of, & !spatial position in memory for this neighbor (offset) + neighbor_ph, & !neighbor's phase + neighbor_tex, & !neighbor's texture ID + ne_slip_ac, & !loop to find neighbor shear + ne_slip, & !slip system index for neighbor + index_kappa, & !index of pushup factors in plasticState + offset_acshear_slip, & !offset in PlasticState for the accumulative shear + j !quickly loop through slip families + + real(pReal) kappa_max, & ! + tmp_myshear_slip, & !temp storage for accumulative shear for me + mprime_cut, & !m' cutoff to consider neighboring effect + avg_acshear_ne, & !the average accumulative shear from my neighbor + tmp_mprime, & !temp holder for m' value + tmp_acshear !temp holder for accumulative shear for m' + + + real(pReal), dimension(plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + m_primes, & !m' between me_alpha(one) and neighbor beta(all) + me_acshear, & !temp storage for ac_shear of one particular system for me + ne_acshear !temp storage for ac_shear of one particular system for one of my neighbor + + real(pReal), dimension(3,plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + slipNormal, & + slipDirect + + real(pReal), dimension(4) :: my_orientation, & !store my orientation + neighbor_orientation, & !store my neighbor orientation + absMisorientation + + real(pReal), dimension(FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) :: & + ne_mprimes !m' between each neighbor + + !***Get my properties + Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) + ph = phaseAt(ipc,ip,el) !get my phase + of = phasememberAt(ipc,ip,el) !get my spatial location offset in memory + textureID = material_texture(1,ip,el) !get my texture ID + instance = phase_plasticityInstance(ph) !get my instance based on phase ID + ns = plastic_phenoplus_totalNslip(instance) + nt = plastic_phenoplus_totalNtwin(instance) + offset_acshear_slip = ns + nt + 2_pInt + index_kappa = ns + nt + 2_pInt + ns + nt !location of kappa in plasticState + mprime_cut = 0.7_pReal !set by Dr.Bieler + + !***gather my accumulative shear from palsticState + FINDMYSHEAR: do j = 1_pInt,ns + me_acshear(j) = plasticState(ph)%state(offset_acshear_slip+j, of) + enddo FINDMYSHEAR + + !***gather my orientation and slip systems + my_orientation = orientation(1:4, ipc, ip, el) + slipNormal(1:3, 1:ns) = lattice_sn(1:3, 1:ns, ph) + slipDirect(1:3, 1:ns) = lattice_sd(1:3, 1:ns, ph) + kappa_max = plastic_phenoplus_kappa_max(instance) !maximum pushups allowed (READIN) + + !***calculate kappa between me and all my neighbors + LOOPMYSLIP: DO me_slip=1_pInt,ns + vld_Nneighbors = Nneighbors + tmp_myshear_slip = me_acshear(me_slip) + tmp_mprime = 0.0_pReal !highest m' from all neighbors + tmp_acshear = 0.0_pReal !accumulative shear from highest m' + + !***go through my neighbors to find highest m' + LOOPNEIGHBORS: DO n=1_pInt,Nneighbors + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) + neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) + neighbor_n = 1 !It is ipc + neighbor_of = phasememberAt( neighbor_n, neighbor_ip, neighbor_el) + neighbor_ph = phaseAt( neighbor_n, neighbor_ip, neighbor_el) + neighbor_tex = material_texture(1,neighbor_ip,neighbor_el) + neighbor_orientation = orientation(1:4, neighbor_n, neighbor_ip, neighbor_el) !ipc is always 1. + absMisorientation = lattice_qDisorientation(my_orientation, & + neighbor_orientation, & + 0_pInt) !no need for explicit calculation of symmetry + + !***find the accumulative shear for this neighbor + LOOPFINDNEISHEAR: DO ne_slip_ac=1_pInt, ns + ne_acshear(ne_slip_ac) = plasticState(ph)%state(offset_acshear_slip+ne_slip_ac, & + neighbor_of) + ENDDO LOOPFINDNEISHEAR + + !***calculate the average accumulative shear and use it as cutoff + avg_acshear_ne = SUM(ne_acshear)/ns + + !*** + IF (ph==neighbor_ph) THEN + !***walk through all the + LOOPNEIGHBORSLIP: DO ne_slip=1_pInt,ns + !***only consider slip system that is active (above average accumulative shear) + IF (ne_acshear(ne_slip) > avg_acshear_ne) THEN + m_primes(ne_slip) = abs(math_mul3x3(slipNormal(1:3,me_slip), & + math_qRot(absMisorientation, slipNormal(1:3,ne_slip)))) & + *abs(math_mul3x3(slipDirect(1:3,me_slip), & + math_qRot(absMisorientation, slipDirect(1:3,ne_slip)))) + !***find the highest m' and corresponding accumulative shear + IF (m_primes(ne_slip) > tmp_mprime) THEN + tmp_mprime = m_primes(ne_slip) + tmp_acshear = ne_acshear(ne_slip) + ENDIF + ENDIF + ENDDO LOOPNEIGHBORSLIP + + ELSE + ne_mprimes(n) = 0.0_pReal + vld_Nneighbors = vld_Nneighbors - 1_pInt + ENDIF + + ENDDO LOOPNEIGHBORS + + !***check if this element close to rim + IF (vld_Nneighbors < Nneighbors) THEN + !***rim voxel, no modification allowed + plasticState(ph)%state(index_kappa+me_slip, of) = 1.0_pReal + ELSE + !***patch voxel, started to calculate push up factor for gamma_dot + IF ((tmp_mprime > mprime_cut) .AND. (tmp_acshear > tmp_myshear_slip)) THEN + plasticState(ph)%state(index_kappa+me_slip, of) = 1.0_pReal / tmp_mprime + ELSE + !***minimum damping factor is 0.5 + plasticState(ph)%state(index_kappa+me_slip, of) = 0.5_pReal + tmp_mprime * 0.5_pReal + ENDIF + ENDIF + + ENDDO LOOPMYSLIP + +end subroutine plastic_phenoplus_microstructure + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenoplus_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) + use math, only: & + math_Plain3333to99, & + math_Mandel6to33 + use lattice, only: & + lattice_Sslip, & + lattice_Sslip_v, & + lattice_Stwin, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NnonSchmid + use material, only: & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + + implicit none + 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 + + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + + integer(pInt) :: & + instance, & + nSlip, & + nTwin,index_Gamma,index_F,index_myFamily, index_kappa, & + f,i,j,k,l,m,n, & + of, & + ph + real(pReal) :: & + tau_slip_pos,tau_slip_neg, & + gdot_slip_pos,gdot_slip_neg, & + dgdot_dtauslip_pos,dgdot_dtauslip_neg, & + gdot_twin,dgdot_dtautwin,tau_twin + real(pReal), dimension(3,3,3,3) :: & + dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor + real(pReal), dimension(3,3,2) :: & + nonSchmid_tensor + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + nSlip = plastic_phenoplus_totalNslip(instance) + nTwin = plastic_phenoplus_totalNtwin(instance) + index_Gamma = nSlip + nTwin + 1_pInt + index_F = nSlip + nTwin + 2_pInt + index_kappa = nSlip + nTwin + 2_pInt +nSlip + nTwin + + Lp = 0.0_pReal + dLp_dTstar3333 = 0.0_pReal + dLp_dTstar99 = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! Slip part + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) + j = j+1_pInt + + ! Calculation of Lp + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) + do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_phenoplus_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_phenoplus_nonSchmidCoeff(k,instance)*& + lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenoplus_nonSchmidCoeff(k,instance)*& + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + enddo + + !***insert non-local effect here by modify gdot with kappa in plastic state + !***this implementation will most likely cause convergence issue + ! gdot_slip_pos = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & + ! ((abs(tau_slip_pos)/(plasticState(ph)%state(j, of)* & + ! plasticState(ph)%state(j+index_kappa, of))) & !in-place modification of gdot + ! **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) + + ! gdot_slip_neg = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & + ! ((abs(tau_slip_neg)/(plasticState(ph)%state(j, of)* & + ! plasticState(ph)%state(j+index_kappa, of))) & !?should we make it direction aware + ! **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) + + !***original calculation + gdot_slip_pos = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & + ((abs(tau_slip_pos)/(plasticState(ph)%state(j, of))) & !in-place modification of gdot + **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) + + gdot_slip_neg = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & + ((abs(tau_slip_neg)/(plasticState(ph)%state(j, of))) & !?should we make it direction aware + **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) + + !***MAGIC HERE***! + !***directly modify the amount of shear happens considering neighborhood + gdot_slip_pos = gdot_slip_pos * plasticState(ph)%state(j+index_kappa, of) + gdot_slip_neg = gdot_slip_neg * plasticState(ph)%state(j+index_kappa, of) + + Lp = Lp + (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + + ! Calculation of the tangent of Lp + if (abs(gdot_slip_pos) > tiny(0.0_pReal)) then + dgdot_dtauslip_pos = gdot_slip_pos*plastic_phenoplus_n_slip(instance)/tau_slip_pos + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & + dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,1) + endif + + if (abs(gdot_slip_neg) > tiny(0.0_pReal)) then + dgdot_dtauslip_neg = gdot_slip_neg*plastic_phenoplus_n_slip(instance)/tau_slip_neg + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & + dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,2) + endif + enddo slipSystems + enddo slipFamilies + +!-------------------------------------------------------------------------------------------------- +! Twinning part + j = 0_pInt + twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) + j = j+1_pInt + + ! Calculation of Lp + tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + gdot_twin = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + plastic_phenoplus_gdot0_twin(instance)*& + (abs(tau_twin)/plasticState(ph)%state(nSlip+j,of))**& + plastic_phenoplus_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) + + ! Calculation of the tangent of Lp + if (abs(gdot_twin) > tiny(0.0_pReal)) then + dgdot_dtautwin = gdot_twin*plastic_phenoplus_n_twin(instance)/tau_twin + 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*lattice_Stwin(k,l,index_myFamily+i,ph)* & + lattice_Stwin(m,n,index_myFamily+i,ph) + endif + enddo twinSystems + enddo twinFamilies + + dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) + + +end subroutine plastic_phenoplus_LpAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenoplus_dotState(Tstar_v,ipc,ip,el) + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_shearTwin, & + lattice_NnonSchmid + use material, only: & + material_phase, & + phaseAt, phasememberAt, & + plasticState, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element !< microstructure state + + integer(pInt) :: & + instance,ph, & + nSlip,nTwin, & + f,i,j,k, & + index_Gamma,index_F,index_myFamily,& + offset_accshear_slip,offset_accshear_twin, offset_kappa, & + of + real(pReal) :: & + c_SlipSlip,c_TwinSlip,c_TwinTwin, & + ssat_offset, & + tau_slip_pos,tau_slip_neg,tau_twin + + real(pReal), dimension(plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip + real(pReal), dimension(plastic_phenoplus_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + + nSlip = plastic_phenoplus_totalNslip(instance) + nTwin = plastic_phenoplus_totalNtwin(instance) + + index_Gamma = nSlip + nTwin + 1_pInt + index_F = nSlip + nTwin + 2_pInt + offset_accshear_slip = nSlip + nTwin + 2_pInt + offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip + offset_kappa = nSlip + nTwin + 2_pInt + nSlip + nTwin + plasticState(ph)%dotState(:,of) = 0.0_pReal + + +!-------------------------------------------------------------------------------------------------- +! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices + c_SlipSlip = plastic_phenoplus_h0_SlipSlip(instance)*& + (1.0_pReal + plastic_phenoplus_twinC(instance)*plasticState(ph)%state(index_F,of)**& + plastic_phenoplus_twinB(instance)) + c_TwinSlip = plastic_phenoplus_h0_TwinSlip(instance)*& + plasticState(ph)%state(index_Gamma,of)**plastic_phenoplus_twinE(instance) + c_TwinTwin = plastic_phenoplus_h0_TwinTwin(instance)*& + plasticState(ph)%state(index_F,of)**plastic_phenoplus_twinD(instance) + +!-------------------------------------------------------------------------------------------------- +! calculate left and right vectors and calculate dot gammas + ssat_offset = plastic_phenoplus_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) + j = 0_pInt + slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems1: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) + j = j+1_pInt + left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part + left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part + !***original implementation + right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & + (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) & + **plastic_phenoplus_a_slip(instance)& + *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & + (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) + !***modify a_slip to get nonlocal effect + ! right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & + ! (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) & + ! **(plastic_phenoplus_a_slip(instance)*plasticState(ph)%state(j+offset_kappa, of))& + ! *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & + ! (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) + right_TwinSlip(j) = 1.0_pReal ! no system-dependent part + +!-------------------------------------------------------------------------------------------------- +! Calculation of dot gamma + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_phenoplus_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + enddo nonSchmidSystems + gdot_slip(j) = plastic_phenoplus_gdot0_slip(instance)*0.5_pReal* & + ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**plastic_phenoplus_n_slip(instance) & + +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenoplus_n_slip(instance))& + *sign(1.0_pReal,tau_slip_pos) + enddo slipSystems1 + enddo slipFamilies1 + + + j = 0_pInt + twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems1: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) + j = j+1_pInt + left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part + left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part + right_SlipTwin(j) = 1.0_pReal ! no system-dependent right part + right_TwinTwin(j) = 1.0_pReal ! no system-dependent right part + +!-------------------------------------------------------------------------------------------------- +! Calculation of dot vol frac + tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + plastic_phenoplus_gdot0_twin(instance)*& + (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& + plastic_phenoplus_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + enddo twinSystems1 + enddo twinFamilies1 + +!-------------------------------------------------------------------------------------------------- +! calculate the overall hardening based on above + j = 0_pInt + slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + slipSystems2: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) + j = j+1_pInt + plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j + c_SlipSlip * left_SlipSlip(j) * & + dot_product(plastic_phenoplus_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & + right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(plastic_phenoplus_hardeningMatrix_SlipTwin(j,1:nTwin,instance), & + right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & + abs(gdot_slip(j)) + plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) + enddo slipSystems2 + enddo slipFamilies2 + + j = 0_pInt + twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems2: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) + j = j+1_pInt + plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j + c_TwinSlip * left_TwinSlip(j) * & + dot_product(plastic_phenoplus_hardeningMatrix_TwinSlip(j,1:nSlip,instance), & + right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + c_TwinTwin * left_TwinTwin(j) * & + dot_product(plastic_phenoplus_hardeningMatrix_TwinTwin(j,1:nTwin,instance), & + right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) + plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) + enddo twinSystems2 + enddo twinFamilies2 + + +end subroutine plastic_phenoplus_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_phenoplus_postResults(Tstar_v,ipc,ip,el) + use material, only: & + material_phase, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NnonSchmid + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element !< microstructure state + + real(pReal), dimension(plastic_phenoplus_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_phenoplus_postResults + + integer(pInt) :: & + instance,ph, of, & + nSlip,nTwin, & + o,f,i,c,j,k, & + index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily,index_kappa + real(pReal) :: & + tau_slip_pos,tau_slip_neg,tau + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + + nSlip = plastic_phenoplus_totalNslip(instance) + nTwin = plastic_phenoplus_totalNtwin(instance) + + index_Gamma = nSlip + nTwin + 1_pInt + index_F = nSlip + nTwin + 2_pInt + index_accshear_slip = nSlip + nTwin + 2_pInt + 1_pInt + index_accshear_twin = nSlip + nTwin + 2_pInt + nSlip + 1_pInt + index_kappa = nSlip + nTwin + 2_pInt + nSlip + nTwin + 1_pInt + + plastic_phenoplus_postResults = 0.0_pReal + c = 0_pInt + + outputsLoop: do o = 1_pInt,plastic_phenoplus_Noutput(instance) + select case(plastic_phenoplus_outputID(o,instance)) + case (resistance_slip_ID) + plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) + c = c + nSlip + + case (accumulatedshear_slip_ID) + plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& + index_accshear_slip+nSlip-1_pInt,of) + c = c + nSlip + + case (shearrate_slip_ID) + j = 0_pInt + slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems1: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) + j = j + 1_pInt + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_phenoplus_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + enddo + plastic_phenoplus_postResults(c+j) = plastic_phenoplus_gdot0_slip(instance)*0.5_pReal* & + ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**plastic_phenoplus_n_slip(instance) & + +(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**plastic_phenoplus_n_slip(instance))& + *sign(1.0_pReal,tau_slip_pos) + + enddo slipSystems1 + enddo slipFamilies1 + c = c + nSlip + + case (resolvedstress_slip_ID) + j = 0_pInt + slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems2: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) + j = j + 1_pInt + plastic_phenoplus_postResults(c+j) = & + dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + enddo slipSystems2 + enddo slipFamilies2 + c = c + nSlip + + case (kappa_slip_ID) + plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = & + plasticState(ph)%state(index_kappa:index_kappa+nSlip-1_pInt,of) + c = c + nSlip + + case (totalshear_ID) + plastic_phenoplus_postResults(c+1_pInt) = & + plasticState(ph)%state(index_Gamma,of) + c = c + 1_pInt + + case (resistance_twin_ID) + plastic_phenoplus_postResults(c+1_pInt:c+nTwin) = & + plasticState(ph)%state(1_pInt+nSlip:1_pInt+nSlip+nTwin-1_pInt,of) + c = c + nTwin + + case (accumulatedshear_twin_ID) + plastic_phenoplus_postResults(c+1_pInt:c+nTwin) = & + plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) + c = c + nTwin + + case (shearrate_twin_ID) + j = 0_pInt + twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems1: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) + j = j + 1_pInt + tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + plastic_phenoplus_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + plastic_phenoplus_gdot0_twin(instance)*& + (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& + plastic_phenoplus_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) + enddo twinSystems1 + enddo twinFamilies1 + c = c + nTwin + + case (resolvedstress_twin_ID) + j = 0_pInt + twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems2: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) + j = j + 1_pInt + plastic_phenoplus_postResults(c+j) = & + dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + enddo twinSystems2 + enddo twinFamilies2 + c = c + nTwin + + case (totalvolfrac_twin_ID) + plastic_phenoplus_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) + c = c + 1_pInt + + end select + enddo outputsLoop + +end function plastic_phenoplus_postResults + +end module plastic_phenoplus diff --git a/code/plastic/plastic_phenopowerlaw.f90 b/code/plastic/plastic_phenopowerlaw.f90 new file mode 100644 index 000000000..1f8e16250 --- /dev/null +++ b/code/plastic/plastic_phenopowerlaw.f90 @@ -0,0 +1,1226 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw +!! fitting +!-------------------------------------------------------------------------------------------------- +module plastic_phenopowerlaw + use prec, only: & + pReal,& + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_phenopowerlaw_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_phenopowerlaw_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_phenopowerlaw_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_phenopowerlaw_Noutput !< number of outputs per instance of this constitution + + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_phenopowerlaw_totalNslip, & !< no. of slip system used in simulation + plastic_phenopowerlaw_totalNtwin, & !< no. of twin system used in simulation + plastic_phenopowerlaw_totalNtrans !< no. of trans system used in simulation + + integer(pInt), dimension(:,:), allocatable, private :: & + plastic_phenopowerlaw_Nslip, & !< active number of slip systems per family (input parameter, per family) + plastic_phenopowerlaw_Ntwin, & !< active number of twin systems per family (input parameter, per family) + plastic_phenopowerlaw_Ntrans !< active number of trans systems per family (input parameter, per family) + + real(pReal), dimension(:), allocatable, private :: & + plastic_phenopowerlaw_gdot0_slip, & !< reference shear strain rate for slip (input parameter) + plastic_phenopowerlaw_gdot0_twin, & !< reference shear strain rate for twin (input parameter) + plastic_phenopowerlaw_n_slip, & !< stress exponent for slip (input parameter) + plastic_phenopowerlaw_n_twin, & !< stress exponent for twin (input parameter) + plastic_phenopowerlaw_spr, & !< push-up factor for slip saturation due to twinning + plastic_phenopowerlaw_twinB, & + plastic_phenopowerlaw_twinC, & + plastic_phenopowerlaw_twinD, & + plastic_phenopowerlaw_twinE, & + plastic_phenopowerlaw_h0_SlipSlip, & !< reference hardening slip - slip (input parameter) + plastic_phenopowerlaw_h0_TwinSlip, & !< reference hardening twin - slip (input parameter) + plastic_phenopowerlaw_h0_TwinTwin, & !< reference hardening twin - twin (input parameter) + plastic_phenopowerlaw_a_slip, & + plastic_phenopowerlaw_aTolResistance, & + plastic_phenopowerlaw_aTolShear, & + plastic_phenopowerlaw_aTolTwinfrac, & + plastic_phenopowerlaw_aTolTransfrac, & + plastic_phenopowerlaw_Cnuc, & !< coefficient for strain-induced martensite nucleation + plastic_phenopowerlaw_Cdwp, & !< coefficient for double well potential + plastic_phenopowerlaw_Cgro, & !< coefficient for stress-assisted martensite growth + plastic_phenopowerlaw_deltaG !< free energy difference between austensite and martensite [MPa] + + real(pReal), dimension(:,:), allocatable, private :: & + plastic_phenopowerlaw_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) + plastic_phenopowerlaw_tau0_twin, & !< initial critical shear stress for twin (input parameter, per family) + plastic_phenopowerlaw_tausat_slip, & !< maximum critical shear stress for slip (input parameter, per family) + plastic_phenopowerlaw_nonSchmidCoeff, & + + plastic_phenopowerlaw_interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) + plastic_phenopowerlaw_interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) + plastic_phenopowerlaw_interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) + plastic_phenopowerlaw_interaction_TwinTwin !< interaction factors twin - twin (input parameter) + + real(pReal), dimension(:,:,:), allocatable, private :: & + plastic_phenopowerlaw_hardeningMatrix_SlipSlip, & + plastic_phenopowerlaw_hardeningMatrix_SlipTwin, & + plastic_phenopowerlaw_hardeningMatrix_TwinSlip, & + plastic_phenopowerlaw_hardeningMatrix_TwinTwin + + enum, bind(c) + enumerator :: undefined_ID, & + resistance_slip_ID, & + accumulatedshear_slip_ID, & + shearrate_slip_ID, & + resolvedstress_slip_ID, & + totalshear_ID, & + resistance_twin_ID, & + accumulatedshear_twin_ID, & + shearrate_twin_ID, & + resolvedstress_twin_ID, & + totalvolfrac_twin_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_phenopowerlaw_outputID !< ID of each post result output + + type, private :: tPhenopowerlawState + real(pReal), pointer, dimension(:,:) :: & + s_slip, & + s_twin, & + accshear_slip, & + accshear_twin + real(pReal), pointer, dimension(:) :: & + sumGamma, & + sumF + end type + + type(tPhenopowerlawState), allocatable, dimension(:), private :: & + dotState, & + state, & + state0 + + public :: & + plastic_phenopowerlaw_init, & + plastic_phenopowerlaw_LpAndItsTangent, & + plastic_phenopowerlaw_dotState, & + plastic_phenopowerlaw_postResults + private :: & + plastic_phenopowerlaw_aTolState, & + plastic_phenopowerlaw_stateInit + + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenopowerlaw_init(fileUnit) + 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 + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_PHENOPOWERLAW_label, & + PLASTICITY_PHENOPOWERLAW_ID, & + material_phase, & + plasticState, & + MATERIAL_partPhase + use lattice + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + maxNinstance, & + instance,phase,j,k, f,o, & + Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & + Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & + Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & + Nchunks_TransFamilies = 0_pInt, Nchunks_nonSchmid = 0_pInt, & + NipcMyPhase, & + offset_slip, index_myFamily, index_otherFamily, & + mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & + startIndex, endIndex + character(len=65536) :: & + tag = '', & + line = '' + real(pReal), dimension(:), allocatable :: tempPerSlip + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + + allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance), & + source=0_pInt) + allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) + plastic_phenopowerlaw_output = '' + allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_Ntrans(lattice_maxNtransFamily,maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_totalNslip(maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_totalNtwin(maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_totalNtrans(maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_gdot0_slip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_n_slip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_tau0_slip(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_tausat_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) + allocate(plastic_phenopowerlaw_gdot0_twin(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_n_twin(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_tau0_twin(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_spr(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_twinB(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_twinC(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_twinD(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_twinE(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_h0_SlipSlip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_h0_TwinSlip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_h0_TwinTwin(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenopowerlaw_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenopowerlaw_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenopowerlaw_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenopowerlaw_a_slip(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_aTolResistance(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_aTolShear(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_aTolTwinfrac(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_aTolTransfrac(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & + source=0.0_pReal) + allocate(plastic_phenopowerlaw_Cnuc(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_Cdwp(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_Cgro(maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_deltaG(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase + Nchunks_TransFamilies = count(lattice_NtransSystem(:,phase) > 0_pInt) ! maximum number of trans families according to lattice type of current phase + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + Nchunks_nonSchmid = lattice_NnonSchmid(phase) + if(allocated(tempPerSlip)) deallocate(tempPerSlip) + allocate(tempPerSlip(Nchunks_SlipFamilies)) + endif + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('resistance_slip') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_slip_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_slip','accumulated_shear_slip') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_slip_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_slip') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_slip_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_slip') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_slip_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalshear') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalshear_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resistance_twin') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_twin_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_twin','accumulated_shear_twin') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_twin_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_twin') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_twin_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_twin') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_twin_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalvolfrac_twin') + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalvolfrac_twin_ID + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case default + + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of slip families + case ('nslip') + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + do j = 1_pInt, Nchunks_SlipFamilies + plastic_phenopowerlaw_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('tausat_slip','tau0_slip') + tempPerSlip = 0.0_pReal + do j = 1_pInt, Nchunks_SlipFamilies + if (plastic_phenopowerlaw_Nslip(j,instance) > 0_pInt) & + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('tausat_slip') + plastic_phenopowerlaw_tausat_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('tau0_slip') + plastic_phenopowerlaw_tau0_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + end select +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of twin families + case ('ntwin') + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_TwinFamilies + plastic_phenopowerlaw_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('tau0_twin') + do j = 1_pInt, Nchunks_TwinFamilies + if (plastic_phenopowerlaw_Ntwin(j,instance) > 0_pInt) & + plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of transformation families + case ('ntrans') + if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + Nchunks_TransFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_TransFamilies + plastic_phenopowerlaw_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of interactions + case ('interaction_slipslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_SlipSlip + plastic_phenopowerlaw_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_sliptwin') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_SlipTwin + plastic_phenopowerlaw_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twinslip') + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_TwinSlip + plastic_phenopowerlaw_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twintwin') + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_TwinTwin + plastic_phenopowerlaw_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('nonschmid_coefficients') + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt,Nchunks_nonSchmid + plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters independent of number of slip/twin systems + case ('gdot0_slip') + plastic_phenopowerlaw_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('n_slip') + plastic_phenopowerlaw_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('a_slip', 'w0_slip') + plastic_phenopowerlaw_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('gdot0_twin') + plastic_phenopowerlaw_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('n_twin') + plastic_phenopowerlaw_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('s_pr') + plastic_phenopowerlaw_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_b') + plastic_phenopowerlaw_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_c') + plastic_phenopowerlaw_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_d') + plastic_phenopowerlaw_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twin_e') + plastic_phenopowerlaw_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('h0_slipslip') + plastic_phenopowerlaw_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('h0_twinslip') + plastic_phenopowerlaw_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('h0_twintwin') + plastic_phenopowerlaw_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_resistance') + plastic_phenopowerlaw_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_shear') + plastic_phenopowerlaw_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_twinfrac') + plastic_phenopowerlaw_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_transfrac') + plastic_phenopowerlaw_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cnuc') + plastic_phenopowerlaw_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cdwp') + plastic_phenopowerlaw_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('cgro') + plastic_phenopowerlaw_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('deltag') + plastic_phenopowerlaw_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) + case default + + end select + endif; endif + enddo parsingFile + + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then + instance = phase_plasticityInstance(phase) + plastic_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance) = & + min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested + plastic_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance)) + plastic_phenopowerlaw_Ntwin(1:lattice_maxNtwinFamily,instance) = & + min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,phase),& ! limit active twin systems per family to min of available and requested + plastic_phenopowerlaw_Ntwin(:,instance)) + plastic_phenopowerlaw_totalNslip(instance) = sum(plastic_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether + plastic_phenopowerlaw_totalNtwin(instance) = sum(plastic_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether + plastic_phenopowerlaw_totalNtrans(instance) = sum(plastic_phenopowerlaw_Ntrans(:,instance)) ! how many trans systems altogether + + if (any(plastic_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & + plastic_phenopowerlaw_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (plastic_phenopowerlaw_gdot0_slip(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (plastic_phenopowerlaw_n_slip(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(plastic_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & + plastic_phenopowerlaw_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(abs(plastic_phenopowerlaw_a_slip(instance)) <= tiny(0.0_pReal) .and. & + plastic_phenopowerlaw_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(plastic_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & + plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if ( plastic_phenopowerlaw_gdot0_twin(instance) <= 0.0_pReal .and. & + any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if ( plastic_phenopowerlaw_n_twin(instance) <= 0.0_pReal .and. & + any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (plastic_phenopowerlaw_aTolResistance(instance) <= 0.0_pReal) & + plastic_phenopowerlaw_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa + if (plastic_phenopowerlaw_aTolShear(instance) <= 0.0_pReal) & + plastic_phenopowerlaw_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (plastic_phenopowerlaw_aTolTwinfrac(instance) <= 0.0_pReal) & + plastic_phenopowerlaw_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (plastic_phenopowerlaw_aTolTransfrac(instance) <= 0.0_pReal) & + plastic_phenopowerlaw_aTolTransfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + endif myPhase + enddo sanityChecks + +!-------------------------------------------------------------------------------------------------- +! allocation of variables whose size depends on the total number of active slip systems + allocate(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from slip activity + maxval(plastic_phenopowerlaw_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from twin activity + maxval(plastic_phenopowerlaw_totalNtwin),& + maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from slip activity + maxval(plastic_phenopowerlaw_totalNslip),& + maxNinstance), source=0.0_pReal) + allocate(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from twin activity + maxval(plastic_phenopowerlaw_totalNtwin),& + maxNinstance), source=0.0_pReal) + allocate(state(maxNinstance)) + allocate(state0(maxNinstance)) + allocate(dotState(maxNinstance)) + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config + myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then ! only consider my phase + NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase + instance = phase_plasticityInstance(phase) ! which instance of my phase + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) + select case(plastic_phenopowerlaw_outputID(o,instance)) + case(resistance_slip_ID, & + shearrate_slip_ID, & + accumulatedshear_slip_ID, & + resolvedstress_slip_ID & + ) + mySize = plastic_phenopowerlaw_totalNslip(instance) + case(resistance_twin_ID, & + shearrate_twin_ID, & + accumulatedshear_twin_ID, & + resolvedstress_twin_ID & + ) + mySize = plastic_phenopowerlaw_totalNtwin(instance) + case(totalshear_ID, & + totalvolfrac_twin_ID & + ) + mySize = 1_pInt + case default + end select + + outputFound: if (mySize > 0_pInt) then + plastic_phenopowerlaw_sizePostResult(o,instance) = mySize + plastic_phenopowerlaw_sizePostResults(instance) = plastic_phenopowerlaw_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + sizeState = plastic_phenopowerlaw_totalNslip(instance) & ! s_slip + + plastic_phenopowerlaw_totalNtwin(instance) & ! s_twin + + 2_pInt & ! sum(gamma) + sum(f) + + plastic_phenopowerlaw_totalNslip(instance) & ! accshear_slip + + plastic_phenopowerlaw_totalNtwin(instance) ! accshear_twin + + sizeDotState = sizeState + sizeDeltaState = 0_pInt + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) + plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) + plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) + plasticState(phase)%nTrans=plastic_phenopowerlaw_totalNtrans(instance) + allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) + allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup ( sizeState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) + + offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + + do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X + index_myFamily = sum(plastic_phenopowerlaw_Nslip(1:f-1_pInt,instance)) + do j = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) ! loop over (active) systems in my family (slip) + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) + plastic_phenopowerlaw_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenopowerlaw_interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + plastic_phenopowerlaw_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenopowerlaw_interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo; enddo + + do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X + index_myFamily = sum(plastic_phenopowerlaw_Ntwin(1:f-1_pInt,instance)) + do j = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) ! loop over (active) systems in my family (twin) + + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) + plastic_phenopowerlaw_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenopowerlaw_interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + plastic_phenopowerlaw_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_phenopowerlaw_interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo; enddo + startIndex = 1_pInt + endIndex = plastic_phenopowerlaw_totalNslip(instance) + state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) + state0 (instance)%s_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) + dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex = endIndex + 1_pInt + endIndex = endIndex + plastic_phenopowerlaw_totalNtwin(instance) + state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) + state0 (instance)%s_twin=>plasticState(phase)%state0 (startIndex:endIndex,:) + dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) + state0 (instance)%sumGamma=>plasticState(phase)%state0 (startIndex,:) + dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) + + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumF=>plasticState(phase)%state (startIndex,:) + state0 (instance)%sumF=>plasticState(phase)%state0 (startIndex,:) + dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) + + startIndex = endIndex + 1_pInt + endIndex = endIndex +plastic_phenopowerlaw_totalNslip(instance) + state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) + state0 (instance)%accshear_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + + startIndex = endIndex + 1_pInt + endIndex = endIndex +plastic_phenopowerlaw_totalNtwin(instance) + state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) + state0 (instance)%accshear_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + + + call plastic_phenopowerlaw_stateInit(phase,instance) + call plastic_phenopowerlaw_aTolState(phase,instance) + endif myPhase2 + enddo initializeInstances + +end subroutine plastic_phenopowerlaw_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the initial microstructural state for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenopowerlaw_stateInit(ph,instance) + use lattice, only: & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + integer(pInt) :: & + i + real(pReal), dimension(plasticState(ph)%sizeState) :: & + tempState + + tempState = 0.0_pReal + do i = 1_pInt,lattice_maxNslipFamily + tempState(1+sum(plastic_phenopowerlaw_Nslip(1:i-1,instance)) : & + sum(plastic_phenopowerlaw_Nslip(1:i ,instance))) = & + plastic_phenopowerlaw_tau0_slip(i,instance) + enddo + + do i = 1_pInt,lattice_maxNtwinFamily + tempState(1+sum(plastic_phenopowerlaw_Nslip(:,instance))+& + sum(plastic_phenopowerlaw_Ntwin(1:i-1,instance)) : & + sum(plastic_phenopowerlaw_Nslip(:,instance))+& + sum(plastic_phenopowerlaw_Ntwin(1:i ,instance))) = & + plastic_phenopowerlaw_tau0_twin(i,instance) + enddo + + plasticState(ph)%state0(:,:) = spread(tempState, & ! spread single tempstate array + 2, & ! along dimension 2 + size(plasticState(ph)%state0(1,:))) ! number of copies (number of IPCs) + +end subroutine plastic_phenopowerlaw_stateInit + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the relevant state values for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenopowerlaw_aTolState(ph,instance) + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: & + instance, & !< number specifying the instance of the plasticity + ph + + plasticState(ph)%aTolState(1:plastic_phenopowerlaw_totalNslip(instance)+ & + plastic_phenopowerlaw_totalNtwin(instance)) = & + plastic_phenopowerlaw_aTolResistance(instance) + plasticState(ph)%aTolState(1+plastic_phenopowerlaw_totalNslip(instance)+ & + plastic_phenopowerlaw_totalNtwin(instance)) = & + plastic_phenopowerlaw_aTolShear(instance) + plasticState(ph)%aTolState(2+plastic_phenopowerlaw_totalNslip(instance)+ & + plastic_phenopowerlaw_totalNtwin(instance)) = & + plastic_phenopowerlaw_aTolTwinFrac(instance) + plasticState(ph)%aTolState(3+plastic_phenopowerlaw_totalNslip(instance)+ & + plastic_phenopowerlaw_totalNtwin(instance): & + 2+2*(plastic_phenopowerlaw_totalNslip(instance)+ & + plastic_phenopowerlaw_totalNtwin(instance))) = & + plastic_phenopowerlaw_aTolShear(instance) + +end subroutine plastic_phenopowerlaw_aTolState + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) + use math, only: & + math_Plain3333to99, & + math_Mandel6to33 + use lattice, only: & + lattice_Sslip, & + lattice_Sslip_v, & + lattice_Stwin, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NnonSchmid + use material, only: & + phaseAt, phasememberAt, & + phase_plasticityInstance + + implicit none + 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 + + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + + integer(pInt) :: & + instance, & + index_myFamily, & + f,i,j,k,l,m,n, & + of, & + ph + real(pReal) :: & + tau_slip_pos,tau_slip_neg, & + gdot_slip_pos,gdot_slip_neg, & + dgdot_dtauslip_pos,dgdot_dtauslip_neg, & + gdot_twin,dgdot_dtautwin,tau_twin + real(pReal), dimension(3,3,3,3) :: & + dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor + real(pReal), dimension(3,3,2) :: & + nonSchmid_tensor + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + + Lp = 0.0_pReal + dLp_dTstar3333 = 0.0_pReal + dLp_dTstar99 = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! Slip part + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + j = j+1_pInt + + ! Calculation of Lp + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) + do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + enddo + gdot_slip_pos = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & + ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & + **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) + + gdot_slip_neg = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & + ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & + **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) + + Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F + (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + + ! Calculation of the tangent of Lp + if (abs(gdot_slip_pos) > tiny(0.0_pReal)) then + dgdot_dtauslip_pos = gdot_slip_pos*plastic_phenopowerlaw_n_slip(instance)/tau_slip_pos + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & + dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,1) + endif + + if (abs(gdot_slip_neg) > tiny(0.0_pReal)) then + dgdot_dtauslip_neg = gdot_slip_neg*plastic_phenopowerlaw_n_slip(instance)/tau_slip_neg + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & + dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,2) + endif + enddo slipSystems + enddo slipFamilies + +!-------------------------------------------------------------------------------------------------- +! Twinning part + j = 0_pInt + twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + j = j+1_pInt + + ! Calculation of Lp + tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F + plastic_phenopowerlaw_gdot0_twin(instance)*& + (abs(tau_twin)/state(instance)%s_twin(j,of))**& + plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) + + ! Calculation of the tangent of Lp + if (abs(gdot_twin) > tiny(0.0_pReal)) then + dgdot_dtautwin = gdot_twin*plastic_phenopowerlaw_n_twin(instance)/tau_twin + 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*lattice_Stwin(k,l,index_myFamily+i,ph)* & + lattice_Stwin(m,n,index_myFamily+i,ph) + endif + enddo twinSystems + enddo twinFamilies + + dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) + + +end subroutine plastic_phenopowerlaw_LpAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_shearTwin, & + lattice_NnonSchmid + use material, only: & + material_phase, & + phaseAt, phasememberAt, & + plasticState, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element !< microstructure state + + integer(pInt) :: & + instance,ph, & + nSlip,nTwin, & + f,i,j,k, & + index_Gamma,index_F,index_myFamily, & + offset_accshear_slip,offset_accshear_twin, & + of + real(pReal) :: & + c_SlipSlip,c_TwinSlip,c_TwinTwin, & + ssat_offset, & + tau_slip_pos,tau_slip_neg,tau_twin + + real(pReal), dimension(plastic_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip + real(pReal), dimension(plastic_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + + nSlip = plastic_phenopowerlaw_totalNslip(instance) + nTwin = plastic_phenopowerlaw_totalNtwin(instance) + + index_Gamma = nSlip + nTwin + 1_pInt + index_F = nSlip + nTwin + 2_pInt + offset_accshear_slip = nSlip + nTwin + 2_pInt + offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip + plasticState(ph)%dotState(:,of) = 0.0_pReal + + +!-------------------------------------------------------------------------------------------------- +! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices + c_SlipSlip = plastic_phenopowerlaw_h0_SlipSlip(instance)*& + (1.0_pReal + plastic_phenopowerlaw_twinC(instance)*plasticState(ph)%state(index_F,of)**& + plastic_phenopowerlaw_twinB(instance)) + c_TwinSlip = plastic_phenopowerlaw_h0_TwinSlip(instance)*& + plasticState(ph)%state(index_Gamma,of)**plastic_phenopowerlaw_twinE(instance) + c_TwinTwin = plastic_phenopowerlaw_h0_TwinTwin(instance)*& + plasticState(ph)%state(index_F,of)**plastic_phenopowerlaw_twinD(instance) + +!-------------------------------------------------------------------------------------------------- +! calculate left and right vectors and calculate dot gammas + ssat_offset = plastic_phenopowerlaw_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) + j = 0_pInt + slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + j = j+1_pInt + left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part + left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part + right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & + (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & + **plastic_phenopowerlaw_a_slip(instance)& + *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & + (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) + right_TwinSlip(j) = 1.0_pReal ! no system-dependent part + +!-------------------------------------------------------------------------------------------------- +! Calculation of dot gamma + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + enddo nonSchmidSystems + gdot_slip(j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & + ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance))& + *sign(1.0_pReal,tau_slip_pos) + enddo slipSystems1 + enddo slipFamilies1 + + + j = 0_pInt + twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + j = j+1_pInt + left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part + left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part + right_SlipTwin(j) = 1.0_pReal ! no system-dependent right part + right_TwinTwin(j) = 1.0_pReal ! no system-dependent right part + +!-------------------------------------------------------------------------------------------------- +! Calculation of dot vol frac + tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + plastic_phenopowerlaw_gdot0_twin(instance)*& + (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& + plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + enddo twinSystems1 + enddo twinFamilies1 + +!-------------------------------------------------------------------------------------------------- +! calculate the overall hardening based on above + j = 0_pInt + slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + j = j+1_pInt + plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j + c_SlipSlip * left_SlipSlip(j) * & + dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & + right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(j,1:nTwin,instance), & + right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & + abs(gdot_slip(j)) + plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) + enddo slipSystems2 + enddo slipFamilies2 + + j = 0_pInt + twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + j = j+1_pInt + plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j + c_TwinSlip * left_TwinSlip(j) * & + dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(j,1:nSlip,instance), & + right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + c_TwinTwin * left_TwinTwin(j) * & + dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(j,1:nTwin,instance), & + right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) + plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) + enddo twinSystems2 + enddo twinFamilies2 + + +end subroutine plastic_phenopowerlaw_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) + use material, only: & + material_phase, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + use lattice, only: & + lattice_Sslip_v, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_NnonSchmid + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element !< microstructure state + + real(pReal), dimension(plastic_phenopowerlaw_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_phenopowerlaw_postResults + + integer(pInt) :: & + instance,ph, of, & + nSlip,nTwin, & + o,f,i,c,j,k, & + index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily + real(pReal) :: & + tau_slip_pos,tau_slip_neg,tau + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + + nSlip = plastic_phenopowerlaw_totalNslip(instance) + nTwin = plastic_phenopowerlaw_totalNtwin(instance) + + index_Gamma = nSlip + nTwin + 1_pInt + index_F = nSlip + nTwin + 2_pInt + index_accshear_slip = nSlip + nTwin + 3_pInt + index_accshear_twin = nSlip + nTwin + 3_pInt + nSlip + + plastic_phenopowerlaw_postResults = 0.0_pReal + c = 0_pInt + + outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) + select case(plastic_phenopowerlaw_outputID(o,instance)) + case (resistance_slip_ID) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) + c = c + nSlip + + case (accumulatedshear_slip_ID) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& + index_accshear_slip+nSlip-1_pInt,of) + c = c + nSlip + + case (shearrate_slip_ID) + j = 0_pInt + slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + j = j + 1_pInt + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_pos + do k = 1,lattice_NnonSchmid(ph) + tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + enddo + plastic_phenopowerlaw_postResults(c+j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & + ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**plastic_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**plastic_phenopowerlaw_n_slip(instance))& + *sign(1.0_pReal,tau_slip_pos) + + enddo slipSystems1 + enddo slipFamilies1 + c = c + nSlip + + case (resolvedstress_slip_ID) + j = 0_pInt + slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + j = j + 1_pInt + plastic_phenopowerlaw_postResults(c+j) = & + dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + enddo slipSystems2 + enddo slipFamilies2 + c = c + nSlip + + case (totalshear_ID) + plastic_phenopowerlaw_postResults(c+1_pInt) = & + plasticState(ph)%state(index_Gamma,of) + c = c + 1_pInt + + case (resistance_twin_ID) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & + plasticState(ph)%state(1_pInt+nSlip:1_pInt+nSlip+nTwin-1_pInt,of) + c = c + nTwin + + case (accumulatedshear_twin_ID) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & + plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) + c = c + nTwin + case (shearrate_twin_ID) + j = 0_pInt + twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + j = j + 1_pInt + tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + plastic_phenopowerlaw_gdot0_twin(instance)*& + (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& + plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) + enddo twinSystems1 + enddo twinFamilies1 + c = c + nTwin + + case (resolvedstress_twin_ID) + j = 0_pInt + twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + j = j + 1_pInt + plastic_phenopowerlaw_postResults(c+j) = & + dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) + enddo twinSystems2 + enddo twinFamilies2 + c = c + nTwin + + case (totalvolfrac_twin_ID) + plastic_phenopowerlaw_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) + c = c + 1_pInt + + end select + enddo outputsLoop + +end function plastic_phenopowerlaw_postResults + +end module plastic_phenopowerlaw diff --git a/code/plastic/plastic_titanmod.f90 b/code/plastic/plastic_titanmod.f90 new file mode 100644 index 000000000..abc6d661b --- /dev/null +++ b/code/plastic/plastic_titanmod.f90 @@ -0,0 +1,1913 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Alankar Alankar, Max-Planck-Institut für Eisenforschung GmbH +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for titanium +!-------------------------------------------------------------------------------------------------- +module plastic_titanmod + use prec, only: & + pReal, & + pInt + + implicit none + private + character(len=18), dimension(3), parameter, private :: & + plastic_titanmod_listBasicSlipStates = & + ['rho_edge ', 'rho_screw ', 'shear_system'] + character(len=18), dimension(1), parameter, private :: & + plastic_titanmod_listBasicTwinStates = ['gdot_twin'] + character(len=19), dimension(11), parameter, private :: & + plastic_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 :: & + plastic_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 :: & + plastic_titanmod_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_titanmod_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_titanmod_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_titanmod_Noutput !< number of outputs per instance of this plasticity !< ID of the lattice structure + + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_titanmod_totalNslip, & !< total number of active slip systems for each instance + plastic_titanmod_totalNtwin !< total number of active twin systems for each instance + + integer(pInt), dimension(:,:), allocatable, private :: & + plastic_titanmod_Nslip, & !< number of active slip systems for each family and instance + plastic_titanmod_Ntwin, & !< number of active twin systems for each family and instance + plastic_titanmod_slipFamily, & !< lookup table relating active slip system to slip family for each instance + plastic_titanmod_twinFamily, & !< lookup table relating active twin system to twin family for each instance + plastic_titanmod_slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance + plastic_titanmod_twinSystemLattice !< lookup table relating active twin system index to lattice twin system index for each instance + + real(pReal), dimension(:), allocatable, private :: & + plastic_titanmod_debyefrequency, & !< Debye frequency + plastic_titanmod_kinkf0, & !< + plastic_titanmod_CAtomicVolume, & !< atomic volume in Bugers vector unit + plastic_titanmod_dc, & !< prefactor for self-diffusion coefficient + plastic_titanmod_twinhpconstant, & !< activation energy for dislocation climb + plastic_titanmod_GrainSize, & !< grain size - Not being used + plastic_titanmod_MaxTwinFraction, & !< maximum allowed total twin volume fraction + plastic_titanmod_r, & !< r-exponent in twin nucleation rate + plastic_titanmod_CEdgeDipMinDistance, & !< Not being used + plastic_titanmod_Cmfptwin, & !< Not being used + plastic_titanmod_Cthresholdtwin, & !< Not being used + plastic_titanmod_aTolRho !< absolute tolerance for integration of dislocation density + + real(pReal), dimension(:,:), allocatable, private :: & + plastic_titanmod_rho_edge0, & !< initial edge dislocation density per slip system for each family and instance + plastic_titanmod_rho_screw0, & !< initial screw dislocation density per slip system for each family and instance + plastic_titanmod_shear_system0, & !< accumulated shear on each system + plastic_titanmod_burgersPerSlipFam, & !< absolute length of burgers vector [m] for each slip family and instance + plastic_titanmod_burgersPerSlipSys, & !< absolute length of burgers vector [m] for each slip system and instance + plastic_titanmod_burgersPerTwinFam, & !< absolute length of burgers vector [m] for each twin family and instance + plastic_titanmod_burgersPerTwinSys, & !< absolute length of burgers vector [m] for each twin system and instance + plastic_titanmod_f0_PerSlipFam, & !< activation energy for glide [J] for each slip family and instance + plastic_titanmod_f0_PerSlipSys, & !< activation energy for glide [J] for each slip system and instance + plastic_titanmod_twinf0_PerTwinFam, & !< activation energy for glide [J] for each twin family and instance + plastic_titanmod_twinf0_PerTwinSys, & !< activation energy for glide [J] for each twin system and instance + plastic_titanmod_twinshearconstant_PerTwinFam, & !< activation energy for glide [J] for each twin family and instance + plastic_titanmod_twinshearconstant_PerTwinSys, & !< activation energy for glide [J] for each twin system and instance + plastic_titanmod_tau0e_PerSlipFam, & !< Initial yield stress for edge dislocations per slip family + plastic_titanmod_tau0e_PerSlipSys, & !< Initial yield stress for edge dislocations per slip system + plastic_titanmod_tau0s_PerSlipFam, & !< Initial yield stress for screw dislocations per slip family + plastic_titanmod_tau0s_PerSlipSys, & !< Initial yield stress for screw dislocations per slip system + plastic_titanmod_twintau0_PerTwinFam, & !< Initial yield stress for edge dislocations per twin family + plastic_titanmod_twintau0_PerTwinSys, & !< Initial yield stress for edge dislocations per twin system + plastic_titanmod_capre_PerSlipFam, & !< Capture radii for edge dislocations per slip family + plastic_titanmod_capre_PerSlipSys, & !< Capture radii for edge dislocations per slip system + plastic_titanmod_caprs_PerSlipFam, & !< Capture radii for screw dislocations per slip family + plastic_titanmod_caprs_PerSlipSys, & !< Capture radii for screw dislocations per slip system + plastic_titanmod_pe_PerSlipFam, & !< p-exponent in glide velocity + plastic_titanmod_ps_PerSlipFam, & !< p-exponent in glide velocity + plastic_titanmod_qe_PerSlipFam, & !< q-exponent in glide velocity + plastic_titanmod_qs_PerSlipFam, & !< q-exponent in glide velocity + plastic_titanmod_pe_PerSlipSys, & !< p-exponent in glide velocity + plastic_titanmod_ps_PerSlipSys, & !< p-exponent in glide velocity + plastic_titanmod_qe_PerSlipSys, & !< q-exponent in glide velocity + plastic_titanmod_qs_PerSlipSys, & !< q-exponent in glide velocity + plastic_titanmod_twinp_PerTwinFam, & !< p-exponent in glide velocity + plastic_titanmod_twinq_PerTwinFam, & !< q-exponent in glide velocity + plastic_titanmod_twinp_PerTwinSys, & !< p-exponent in glide velocity + plastic_titanmod_twinq_PerTwinSys, & !< p-exponent in glide velocity + plastic_titanmod_v0e_PerSlipFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance + plastic_titanmod_v0e_PerSlipSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance + plastic_titanmod_v0s_PerSlipFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance + plastic_titanmod_v0s_PerSlipSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance + plastic_titanmod_twingamma0_PerTwinFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance + plastic_titanmod_twingamma0_PerTwinSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance + plastic_titanmod_kinkcriticallength_PerSlipFam, & !< screw dislocation mobility prefactor for kink-pairs per slip family + plastic_titanmod_kinkcriticallength_PerSlipSys, & !< screw dislocation mobility prefactor for kink-pairs per slip system + plastic_titanmod_twinsizePerTwinFam, & !< twin thickness [m] for each twin family and instance + plastic_titanmod_twinsizePerTwinSys, & !< twin thickness [m] for each twin system and instance + plastic_titanmod_CeLambdaSlipPerSlipFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance + plastic_titanmod_CeLambdaSlipPerSlipSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + plastic_titanmod_CsLambdaSlipPerSlipFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance + plastic_titanmod_CsLambdaSlipPerSlipSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + plastic_titanmod_twinLambdaSlipPerTwinFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance + plastic_titanmod_twinLambdaSlipPerTwinSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + plastic_titanmod_interactionSlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance + plastic_titanmod_interaction_ee, & !< coefficients for e-e interaction for each interaction type and instance + plastic_titanmod_interaction_ss, & !< coefficients for s-s interaction for each interaction type and instance + plastic_titanmod_interaction_es, & !< coefficients for e-s-twin interaction for each interaction type and instance + plastic_titanmod_interactionSlipTwin, & !< coefficients for twin-slip interaction for each interaction type and instance + plastic_titanmod_interactionTwinSlip, & !< coefficients for twin-slip interaction for each interaction type and instance + plastic_titanmod_interactionTwinTwin !< coefficients for twin-twin interaction for each interaction type and instance + + real(pReal), dimension(:,:,:), allocatable, private :: & + plastic_titanmod_interactionMatrixSlipSlip, & !< interaction matrix of the different slip systems for each instance + plastic_titanmod_interactionMatrix_ee, & !< interaction matrix of e-e for each instance + plastic_titanmod_interactionMatrix_ss, & !< interaction matrix of s-s for each instance + plastic_titanmod_interactionMatrix_es, & !< interaction matrix of e-s for each instance + plastic_titanmod_interactionMatrixSlipTwin, & !< interaction matrix of slip systems with twin systems for each instance + plastic_titanmod_interactionMatrixTwinSlip, & !< interaction matrix of twin systems with slip systems for each instance + plastic_titanmod_interactionMatrixTwinTwin, & !< interaction matrix of the different twin systems for each instance + plastic_titanmod_forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance + plastic_titanmod_forestProjectionScrew, & !< matrix of forest projections of screw dislocations for each instance + plastic_titanmod_TwinforestProjectionEdge, & !< matrix of forest projections of edge dislocations in twin system for each instance + plastic_titanmod_TwinforestProjectionScrew !< matrix of forest projections of screw dislocations in twin system for each instance + + real(pReal), dimension(:,:,:,:), allocatable, private :: & + plastic_titanmod_Ctwin66 !< twin elasticity matrix in Mandel notation for each instance + + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & + plastic_titanmod_Ctwin3333 !< twin elasticity matrix for each instance + + enum, bind(c) + enumerator :: undefined_ID, & + rhoedge_ID, rhoscrew_ID, & + segment_edge_ID, segment_screw_ID, & + resistance_edge_ID, resistance_screw_ID, & + velocity_edge_ID, velocity_screw_ID, & + tau_slip_ID, & + gdot_slip_edge_ID, gdot_slip_screw_ID, & + gdot_slip_ID, & + stressratio_edge_p_ID, stressratio_screw_p_ID, & + shear_system_ID, & + twin_fraction_ID, & + shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & + rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & + rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & + shear_total_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + plastic_titanmod_outputID !< ID of each post result output + + public :: & + plastic_titanmod_microstructure, & + plastic_titanmod_stateInit, & + plastic_titanmod_init, & + plastic_titanmod_LpAndItsTangent, & + plastic_titanmod_dotState, & + plastic_titanmod_postResults, & + plastic_titanmod_homogenizedC + + contains + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_titanmod_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_TITANMOD_label, & + PLASTICITY_TITANMOD_ID, & + plasticState, & + MATERIAL_partPhase + use lattice + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + phase, & + instance, j, k, l, m, n, p, q, r, & + f, o, & + s, s1, s2, & + t, t1, t2, & + ns, nt, & + Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & + Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & + offset_slip, mySize, & + maxTotalNslip,maxTotalNtwin, maxNinstance + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase = 0_pInt + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_TITANMOD_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_plasticity == PLASTICITY_TITANMOD_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(plastic_titanmod_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_titanmod_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) + allocate(plastic_titanmod_output(maxval(phase_Noutput),maxNinstance)) + plastic_titanmod_output = '' + allocate(plastic_titanmod_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(plastic_titanmod_Noutput(maxNinstance), source=0_pInt) + + allocate(plastic_titanmod_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(plastic_titanmod_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) + allocate(plastic_titanmod_slipFamily(lattice_maxNslip,maxNinstance), source=0_pInt) + allocate(plastic_titanmod_twinFamily(lattice_maxNtwin,maxNinstance), source=0_pInt) + allocate(plastic_titanmod_slipSystemLattice(lattice_maxNslip,maxNinstance), source=0_pInt) + allocate(plastic_titanmod_twinSystemLattice(lattice_maxNtwin,maxNinstance), source=0_pInt) + allocate(plastic_titanmod_totalNslip(maxNinstance), source=0_pInt) + allocate(plastic_titanmod_totalNtwin(maxNinstance), source=0_pInt) + allocate(plastic_titanmod_debyefrequency(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_kinkf0(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_CAtomicVolume(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_dc(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinhpconstant(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_GrainSize(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_MaxTwinFraction(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_r(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_Cmfptwin(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_Cthresholdtwin(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_aTolRho(maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_rho_edge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_rho_screw0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_shear_system0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_burgersPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_burgersPerTwinFam(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_f0_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_tau0e_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_tau0s_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_capre_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_caprs_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_pe_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_ps_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_qe_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_qs_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_v0e_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_v0s_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_kinkcriticallength_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinsizePerTwinFam(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_CeLambdaSlipPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_CsLambdaSlipPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + + allocate(plastic_titanmod_twinf0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinshearconstant_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twintau0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinp_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinq_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twingamma0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinLambdaSlipPerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) + + allocate(plastic_titanmod_interactionSlipSlip(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interaction_ee(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interaction_ss(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interaction_es(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionSlipTwin(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionTwinSlip(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionTwinTwin(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next section + phase = phase + 1_pInt ! advance section counter + if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + endif + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then ! one of my sections. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('rhoedge') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoscrew') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('segment_edge') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_edge_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('segment_screw') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_screw_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resistance_edge') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_edge_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resistance_screw') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_screw_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('velocity_edge') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_edge_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('velocity_screw') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_screw_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('tau_slip') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = tau_slip_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('gdot_slip_edge') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_edge_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('gdot_slip_screw') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_screw_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('gdot_slip') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('stressratio_edge_p') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_edge_p_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('stressratio_screw_p') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_screw_p_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_system') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_system_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('twin_fraction') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = twin_fraction_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_basal') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_basal_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_prism') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_prism_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_pyra') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyra_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_pyrca') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyrca_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoedge_basal') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_basal_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoedge_prism') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_prism_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoedge_pyra') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyra_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoedge_pyrca') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyrca_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoscrew_basal') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_basal_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoscrew_prism') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_prism_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoscrew_pyra') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyra_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rhoscrew_pyrca') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyrca_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shear_total') + plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt + plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_total_ID + plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + case ('debyefrequency') + plastic_titanmod_debyefrequency(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('kinkf0') + plastic_titanmod_kinkf0(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('nslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('ntwin') + if (chunkPos(1) < 1_pInt + Nchunks_TwinFamilies) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + case ('rho_edge0') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_rho_edge0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('rho_screw0') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_rho_screw0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('slipburgers') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_burgersPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twinburgers') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_burgersPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('f0') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_f0_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twinf0') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twinf0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('tau0e') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_tau0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twintau0') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twintau0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('tau0s') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_tau0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('capre') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_capre_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('caprs') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_caprs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('v0e') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_v0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twingamma0') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twingamma0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('v0s') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_v0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('kinkcriticallength') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_kinkcriticallength_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twinsize') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twinsizePerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('celambdaslip') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_CeLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twinlambdaslip') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twinlambdaslipPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('cslambdaslip') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_CsLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('grainsize') + plastic_titanmod_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('maxtwinfraction') + plastic_titanmod_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('pe') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_pe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twinp') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twinp_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('ps') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_ps_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('qe') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_qe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twinq') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twinq_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('qs') + do j = 1_pInt, Nchunks_SlipFamilies + plastic_titanmod_qs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('twinshearconstant') + do j = 1_pInt, Nchunks_TwinFamilies + plastic_titanmod_twinshearconstant_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('dc') + plastic_titanmod_dc(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('twinhpconstant') + plastic_titanmod_twinhpconstant(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('atol_rho') + plastic_titanmod_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) + case ('interactionee') + do j = 1_pInt, lattice_maxNinteraction + plastic_titanmod_interaction_ee(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interactionss') + do j = 1_pInt, lattice_maxNinteraction + plastic_titanmod_interaction_ss(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interactiones') + do j = 1_pInt, lattice_maxNinteraction + plastic_titanmod_interaction_es(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_slipslip','interactionslipslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_SlipSlip + plastic_titanmod_interactionSlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_sliptwin','interactionsliptwin') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_SlipTwin + plastic_titanmod_interactionSlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twinslip','interactiontwinslip') + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_TwinSlip + plastic_titanmod_interactionTwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('interaction_twintwin','interactiontwintwin') + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_TwinTwin + plastic_titanmod_interactionTwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + end select + endif; endif + enddo parsingFile + + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then + instance = phase_plasticityInstance(phase) + if (sum(plastic_titanmod_Nslip(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='nslip ('//PLASTICITY_TITANMOD_label//')') + if (sum(plastic_titanmod_Ntwin(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='ntwin ('//PLASTICITY_TITANMOD_label//')') + do f = 1_pInt,lattice_maxNslipFamily + if (plastic_titanmod_Nslip(f,instance) > 0_pInt) then + if (plastic_titanmod_rho_edge0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rho_edge0 ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_rho_screw0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rho_screw0 ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_burgersPerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='slipburgers ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_f0_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='f0 ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_tau0e_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='tau0e ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_tau0s_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='tau0s ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_capre_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='capre ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_caprs_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='caprs ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_v0e_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='v0e ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_v0s_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='v0s ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_kinkcriticallength_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='kinkCriticalLength ('//PLASTICITY_TITANMOD_label//')') + endif + enddo + do f = 1_pInt,lattice_maxNtwinFamily + if (plastic_titanmod_Ntwin(f,instance) > 0_pInt) then + if (plastic_titanmod_burgersPerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_twinf0_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinf0 ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_twinshearconstant_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinshearconstant ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_twintau0_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twintau0 ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_twingamma0_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twingamma0 ('//PLASTICITY_TITANMOD_label//')') + endif + enddo + if (plastic_titanmod_dc(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='dc ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_twinhpconstant(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinhpconstant ('//PLASTICITY_TITANMOD_label//')') + if (plastic_titanmod_aTolRho(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTol_rho ('//PLASTICITY_TITANMOD_label//')') + +!-------------------------------------------------------------------------------------------------- +! determine total number of active slip or twin systems + plastic_titanmod_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_titanmod_Nslip(:,instance)) + plastic_titanmod_Ntwin(:,instance) = min(lattice_NtwinSystem(:,phase),plastic_titanmod_Ntwin(:,instance)) + plastic_titanmod_totalNslip(instance) = sum(plastic_titanmod_Nslip(:,instance)) + plastic_titanmod_totalNtwin(instance) = sum(plastic_titanmod_Ntwin(:,instance)) + endif myPhase + enddo sanityChecks + +!-------------------------------------------------------------------------------------------------- +! allocation of variables whose size depends on the total number of active slip systems + maxTotalNslip = maxval(plastic_titanmod_totalNslip) + maxTotalNtwin = maxval(plastic_titanmod_totalNtwin) + + allocate(plastic_titanmod_burgersPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) + + allocate(plastic_titanmod_f0_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_tau0e_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_tau0s_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_capre_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_caprs_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_pe_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_ps_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_qe_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_qs_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_v0e_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_v0s_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_kinkcriticallength_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_CeLambdaSlipPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_CsLambdaSlipPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) + + allocate(plastic_titanmod_burgersPerTwinSys(maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinf0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinshearconstant_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twintau0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinp_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinq_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twingamma0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinsizePerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_twinLambdaSlipPerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_Ctwin66 (6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_Ctwin3333 (3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) + + allocate(plastic_titanmod_interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionMatrix_ee(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionMatrix_ss(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionMatrix_es(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionMatrixSlipTwin(maxTotalNslip,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionMatrixTwinSlip(maxTotalNtwin,maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_interactionMatrixTwinTwin(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_TwinforestProjectionEdge(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(plastic_titanmod_TwinforestProjectionScrew(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then + instance = phase_plasticityInstance(phase) + +!-------------------------------------------------------------------------------------------------- +! inverse lookup of slip system family + l = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily + do s = 1_pInt,plastic_titanmod_Nslip(f,instance) + l = l + 1_pInt + plastic_titanmod_slipFamily(l,instance) = f + plastic_titanmod_slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt,phase)) + s + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! inverse lookup of twin system family + l = 0_pInt + do f = 1_pInt,lattice_maxNtwinFamily + do t = 1_pInt,plastic_titanmod_Ntwin(f,instance) + l = l + 1_pInt + plastic_titanmod_twinFamily(l,instance) = f + plastic_titanmod_twinSystemLattice(l,instance) = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) + t + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! determine size of state array + ns = plastic_titanmod_totalNslip(instance) + nt = plastic_titanmod_totalNtwin(instance) + + sizeDotState = & + size(plastic_titanmod_listBasicSlipStates)*ns + & + size(plastic_titanmod_listBasicTwinStates)*nt + sizeState = sizeDotState+ & + size(plastic_titanmod_listDependentSlipStates)*ns + & + size(plastic_titanmod_listDependentTwinStates)*nt + sizeDeltaState = 0_pInt + +!-------------------------------------------------------------------------------------------------- +! determine size of postResults array + outputsLoop: do o = 1_pInt,plastic_titanmod_Noutput(instance) + mySize = 0_pInt + select case(plastic_titanmod_outputID(o,instance)) + case(rhoedge_ID, rhoscrew_ID, & + segment_edge_ID, segment_screw_ID, & + resistance_edge_ID, resistance_screw_ID, & + velocity_edge_ID, velocity_screw_ID, & + tau_slip_ID, & + gdot_slip_edge_ID, gdot_slip_screw_ID, & + gdot_slip_ID, & + stressratio_edge_p_ID, stressratio_screw_p_ID, & + shear_system_ID) + mySize = plastic_titanmod_totalNslip(instance) + case(twin_fraction_ID) + mySize = plastic_titanmod_totalNtwin(instance) + case(shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & ! use only if all 4 slip families in hex are considered + rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & + rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & + shear_total_ID) + mySize = 1_pInt + case default + call IO_error(105_pInt,ext_msg=plastic_titanmod_output(o,instance)// & + ' ('//PLASTICITY_TITANMOD_label//')') + end select + + outputFound: if (mySize > 0_pInt) then + plastic_titanmod_sizePostResult(o,instance) = mySize + plastic_titanmod_sizePostResults(instance) = plastic_titanmod_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop +! Determine size of state array + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_titanmod_sizePostResults(instance) + plasticState(phase)%nSlip =plastic_titanmod_totalNslip(instance) + plasticState(phase)%nTwin = 0_pInt + plasticState(phase)%nTrans= 0_pInt + allocate(plasticState(phase)%aTolState (sizeState), source=plastic_titanmod_aTolRho(instance)) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + offset_slip = 2_pInt*plasticState(phase)%nSlip+1 + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) +!-------------------------------------------------------------------------------------------------- +! construction of the twin elasticity matrices + do j=1_pInt,lattice_maxNtwinFamily + do k=1_pInt,plastic_titanmod_Ntwin(j,instance) + 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 + plastic_titanmod_Ctwin3333(l,m,n,o,sum(plastic_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) = & + plastic_titanmod_Ctwin3333(l,m,n,o,sum(plastic_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) + & + lattice_C3333(p,q,r,s,phase)*& + lattice_Qtwin(l,p,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & + lattice_Qtwin(m,q,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & + lattice_Qtwin(n,r,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & + lattice_Qtwin(o,s,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase) + enddo; enddo; enddo; enddo + enddo; enddo; enddo ; enddo + plastic_titanmod_Ctwin66(1:6,1:6,k,instance) = & + math_Mandel3333to66(plastic_titanmod_Ctwin3333(1:3,1:3,1:3,1:3,k,instance)) + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! Burgers vector, dislocation velocity prefactor for each slip system + do s = 1_pInt,plastic_titanmod_totalNslip(instance) + f = plastic_titanmod_slipFamily(s,instance) + + plastic_titanmod_burgersPerSlipSys(s,instance) = & + plastic_titanmod_burgersPerSlipFam(f,instance) + + plastic_titanmod_f0_PerSlipSys(s,instance) = & + plastic_titanmod_f0_PerSlipFam(f,instance) + + plastic_titanmod_tau0e_PerSlipSys(s,instance) = & + plastic_titanmod_tau0e_PerSlipFam(f,instance) + + plastic_titanmod_tau0s_PerSlipSys(s,instance) = & + plastic_titanmod_tau0s_PerSlipFam(f,instance) + + plastic_titanmod_capre_PerSlipSys(s,instance) = & + plastic_titanmod_capre_PerSlipFam(f,instance) + + plastic_titanmod_caprs_PerSlipSys(s,instance) = & + plastic_titanmod_caprs_PerSlipFam(f,instance) + + plastic_titanmod_v0e_PerSlipSys(s,instance) = & + plastic_titanmod_v0e_PerSlipFam(f,instance) + + plastic_titanmod_v0s_PerSlipSys(s,instance) = & + plastic_titanmod_v0s_PerSlipFam(f,instance) + + plastic_titanmod_kinkcriticallength_PerSlipSys(s,instance) = & + plastic_titanmod_kinkcriticallength_PerSlipFam(f,instance) + + plastic_titanmod_pe_PerSlipSys(s,instance) = & + plastic_titanmod_pe_PerSlipFam(f,instance) + + plastic_titanmod_ps_PerSlipSys(s,instance) = & + plastic_titanmod_ps_PerSlipFam(f,instance) + + plastic_titanmod_qe_PerSlipSys(s,instance) = & + plastic_titanmod_qe_PerSlipFam(f,instance) + + plastic_titanmod_qs_PerSlipSys(s,instance) = & + plastic_titanmod_qs_PerSlipFam(f,instance) + + plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance) = & + plastic_titanmod_CeLambdaSlipPerSlipFam(f,instance) + + plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance) = & + plastic_titanmod_CsLambdaSlipPerSlipFam(f,instance) + enddo + +!-------------------------------------------------------------------------------------------------- +! Burgers vector, nucleation rate prefactor and twin size for each twin system + do t = 1_pInt,plastic_titanmod_totalNtwin(instance) + f = plastic_titanmod_twinFamily(t,instance) + + plastic_titanmod_burgersPerTwinSys(t,instance) = & + plastic_titanmod_burgersPerTwinFam(f,instance) + + plastic_titanmod_twinsizePerTwinSys(t,instance) = & + plastic_titanmod_twinsizePerTwinFam(f,instance) + + plastic_titanmod_twinf0_PerTwinSys(t,instance) = & + plastic_titanmod_twinf0_PerTwinFam(f,instance) + + plastic_titanmod_twinshearconstant_PerTwinSys(t,instance) = & + plastic_titanmod_twinshearconstant_PerTwinFam(f,instance) + + plastic_titanmod_twintau0_PerTwinSys(t,instance) = & + plastic_titanmod_twintau0_PerTwinFam(f,instance) + + plastic_titanmod_twingamma0_PerTwinSys(t,instance) = & + plastic_titanmod_twingamma0_PerTwinFam(f,instance) + + plastic_titanmod_twinp_PerTwinSys(t,instance) = & + plastic_titanmod_twinp_PerTwinFam(f,instance) + + plastic_titanmod_twinq_PerTwinSys(t,instance) = & + plastic_titanmod_twinq_PerTwinFam(f,instance) + + plastic_titanmod_twinLambdaSlipPerTwinSys(t,instance) = & + plastic_titanmod_twinLambdaSlipPerTwinFam(f,instance) + enddo + +!-------------------------------------------------------------------------------------------------- +! Construction of interaction matrices + do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) + do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) + plastic_titanmod_interactionMatrixSlipSlip(s1,s2,instance) = & + plastic_titanmod_interactionSlipSlip(lattice_interactionSlipSlip( & + plastic_titanmod_slipSystemLattice(s1,instance),& + plastic_titanmod_slipSystemLattice(s2,instance),phase),instance) + + plastic_titanmod_interactionMatrix_ee(s1,s2,instance) = & + plastic_titanmod_interaction_ee(lattice_interactionSlipSlip ( & + plastic_titanmod_slipSystemLattice(s1,instance), & + plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) + + plastic_titanmod_interactionMatrix_ss(s1,s2,instance) = & + plastic_titanmod_interaction_ss(lattice_interactionSlipSlip( & + plastic_titanmod_slipSystemLattice(s1,instance), & + plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) + + plastic_titanmod_interactionMatrix_es(s1,s2,instance) = & + plastic_titanmod_interaction_es(lattice_interactionSlipSlip( & + plastic_titanmod_slipSystemLattice(s1,instance), & + plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) + enddo; enddo + + do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) + do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) + plastic_titanmod_interactionMatrixSlipTwin(s1,t2,instance) = & + plastic_titanmod_interactionSlipTwin(lattice_interactionSlipTwin( & + plastic_titanmod_slipSystemLattice(s1,instance), & + plastic_titanmod_twinSystemLattice(t2,instance), phase),instance) + enddo; enddo + + do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) + do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) + plastic_titanmod_interactionMatrixTwinSlip(t1,s2,instance) = & + plastic_titanmod_interactionTwinSlip(lattice_interactionTwinSlip( & + plastic_titanmod_twinSystemLattice(t1,instance), & + plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) + enddo; enddo + + do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) + do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) + plastic_titanmod_interactionMatrixTwinTwin(t1,t2,instance) = & + plastic_titanmod_interactionTwinTwin(lattice_interactionTwinTwin( & + plastic_titanmod_twinSystemLattice(t1,instance), & + plastic_titanmod_twinSystemLattice(t2,instance), phase),instance) + enddo; enddo + + do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) + do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) +!-------------------------------------------------------------------------------------------------- +! calculation of forest projections for edge dislocations + plastic_titanmod_forestProjectionEdge(s1,s2,instance) = & + abs(math_mul3x3(lattice_sn(:,plastic_titanmod_slipSystemLattice(s1,instance),phase), & + lattice_st(:,plastic_titanmod_slipSystemLattice(s2,instance),phase))) + +!-------------------------------------------------------------------------------------------------- +! calculation of forest projections for screw dislocations + plastic_titanmod_forestProjectionScrew(s1,s2,instance) = & + abs(math_mul3x3(lattice_sn(:,plastic_titanmod_slipSystemLattice(s1,instance),phase), & + lattice_sd(:,plastic_titanmod_slipSystemLattice(s2,instance),phase))) + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! calculation of forest projections for edge dislocations in twin system + do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) + do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) + plastic_titanmod_TwinforestProjectionEdge(t1,t2,instance) = & + abs(math_mul3x3(lattice_tn(:,plastic_titanmod_twinSystemLattice(t1,instance),phase), & + lattice_tt(:,plastic_titanmod_twinSystemLattice(t2,instance),phase))) + +!-------------------------------------------------------------------------------------------------- +! calculation of forest projections for screw dislocations in twin system + plastic_titanmod_TwinforestProjectionScrew(t1,t2,instance) = & + abs(math_mul3x3(lattice_tn(:,plastic_titanmod_twinSystemLattice(t1,instance),phase), & + lattice_td(:,plastic_titanmod_twinSystemLattice(t2,instance),phase))) + enddo; enddo + call plastic_titanmod_stateInit(phase,instance) + endif + enddo initializeInstances + +end subroutine plastic_titanmod_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets the initial microstructural state for a given instance of this plasticity +!-------------------------------------------------------------------------------------------------- +subroutine plastic_titanmod_stateInit(ph,instance) + use lattice, only: & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_mu + + use material, only: & + plasticState + + implicit none + integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity + integer(pInt), intent(in) :: ph !< number specifying the phase of the plasticity + + + integer(pInt) :: & + s,s0,s1, & + t,t0,t1, & + ns,nt,f + real(pReal), dimension(plastic_titanmod_totalNslip(instance)) :: & + rho_edge0, & + rho_screw0, & + shear_system0, & + segment_edge0, & + segment_screw0, & + resistance_edge0, & + resistance_screw0 + real(pReal), dimension(plastic_titanmod_totalNtwin(instance)) :: & + twingamma_dot0, & + resistance_twin0 + real(pReal), dimension(plasticState(ph)%sizeState) :: tempState !!!!!!!!!????????? check + + ns = plastic_titanmod_totalNslip(instance) + nt = plastic_titanmod_totalNtwin(instance) + + tempState = 0.0_pReal +!-------------------------------------------------------------------------------------------------- +! initialize basic slip state variables for slip + s1 = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily + s0 = s1 + 1_pInt + s1 = s0 + plastic_titanmod_Nslip(f,instance) - 1_pInt + do s = s0,s1 + rho_edge0(s) = plastic_titanmod_rho_edge0(f,instance) + rho_screw0(s) = plastic_titanmod_rho_screw0(f,instance) + shear_system0(s) = 0.0_pReal + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! initialize basic slip state variables for twin + t1 = 0_pInt + do f = 1_pInt,lattice_maxNtwinFamily + t0 = t1 + 1_pInt + t1 = t0 + plastic_titanmod_Ntwin(f,instance) - 1_pInt + do t = t0,t1 + twingamma_dot0(t)=0.0_pReal + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! initialize dependent slip microstructural variables + forall (s = 1_pInt:ns) + segment_edge0(s) = plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & + sqrt(dot_product((rho_edge0),plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & + dot_product((rho_screw0),plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) + segment_screw0(s) = plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & + sqrt(dot_product((rho_edge0),plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & + dot_product((rho_screw0),plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) + resistance_edge0(s) = & + lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)* & + sqrt(dot_product((rho_edge0),plastic_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & + dot_product((rho_screw0),plastic_titanmod_interactionMatrix_es(1:ns,s,instance))) + resistance_screw0(s) = & + lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)* & + sqrt(dot_product((rho_edge0),plastic_titanmod_interactionMatrix_es(1:ns,s,instance))+ & + dot_product((rho_screw0), plastic_titanmod_interactionMatrix_ss(1:ns,s,instance))) + end forall + + forall (t = 1_pInt:nt) & + resistance_twin0(t) = 0.0_pReal + +tempState = 0.0_pReal +tempState (1:ns) = rho_edge0 +tempState (1_pInt*ns+1_pInt:2_pInt*ns) = rho_screw0 +tempState (2_pInt*ns+1_pInt:3_pInt*ns) = shear_system0 +tempState (3_pInt*ns+1_pInt:3_pInt*ns+nt) = twingamma_dot0 +tempState (3_pInt*ns+nt+1_pInt:4_pInt*ns+nt) = segment_edge0 +tempState (4_pInt*ns+nt+1_pInt:5_pInt*ns+nt) = segment_screw0 +tempState (5_pInt*ns+nt+1_pInt:6_pInt*ns+nt) = resistance_edge0 +tempState (6_pInt*ns+nt+1_pInt:7_pInt*ns+nt) = resistance_screw0 +tempState (7_pInt*ns+nt+1_pInt:7_pInt*ns+2_pInt*nt)=resistance_twin0 + +plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) +end subroutine plastic_titanmod_stateInit + +!-------------------------------------------------------------------------------------------------- +!> @brief returns the homogenized elasticity matrix +!-------------------------------------------------------------------------------------------------- +function plastic_titanmod_homogenizedC(ipc,ip,el) + use material, only: & + material_phase, & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_C66 + +implicit none + real(pReal), dimension(6,6) :: & + plastic_titanmod_homogenizedC + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element +real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + volumefraction_PerTwinSys + integer(pInt) :: & + ph, & + of, & + instance, & + ns, nt, & + i + real(pReal) :: & + sumf + +!-------------------------------------------------------------------------------------------------- +! shortened notation +! ph = material_phase(ipc,ip,el) + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_titanmod_totalNslip(instance) + nt = plastic_titanmod_totalNtwin(instance) + +!-------------------------------------------------------------------------------------------------- +! total twin volume fraction + do i=1_pInt,nt + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & + plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) + enddo + sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 + +!-------------------------------------------------------------------------------------------------- +! homogenized elasticity matrix + plastic_titanmod_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,ph) + do i=1_pInt,nt + plastic_titanmod_homogenizedC = plastic_titanmod_homogenizedC & + + volumefraction_PerTwinSys(i)*& + plastic_titanmod_Ctwin66(1:6,1:6,i,instance) + enddo + +end function plastic_titanmod_homogenizedC + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine plastic_titanmod_microstructure(temperature,ipc,ip,el) + + use material, only: & + material_phase,& + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_mu + + 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 + integer(pInt) :: & + instance, & + ns, nt, s, t, & + i, & + ph, & + of + real(pReal) :: & + sumf, & + sfe ! stacking fault energy + real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + volumefraction_PerTwinSys + +!-------------------------------------------------------------------------------------------------- + +!Shortened notation + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_titanmod_totalNslip(instance) + nt = plastic_titanmod_totalNtwin(instance) + +!-------------------------------------------------------------------------------------------------- +! total twin volume fraction + forall (i = 1_pInt:nt) & + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & + plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) + + sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 + + sfe = 0.0002_pReal*Temperature-0.0396_pReal + +!-------------------------------------------------------------------------------------------------- +! average segment length for edge dislocations in matrix + forall (s = 1_pInt:ns) & + plasticState(ph)%state(3_pInt*ns+nt+s, of) = plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & + sqrt(dot_product(plasticState(ph)%state(1:ns, of), & + plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & + dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & + plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) +!-------------------------------------------------------------------------------------------------- +! average segment length for screw dislocations in matrix + forall (s = 1_pInt:ns) & + plasticState(ph)%state(4_pInt*ns+nt+s, of) = plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & + sqrt(dot_product(plasticState(ph)%state(1:ns, of), & + plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & + dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & + plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) +!-------------------------------------------------------------------------------------------------- +! threshold stress or slip resistance for edge dislocation motion + forall (s = 1_pInt:ns) & + plasticState(ph)%state(5_pInt*ns+nt+s, of) = & + lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)*& + sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& + plastic_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & + dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& + plastic_titanmod_interactionMatrix_es(1:ns,s,instance))) +!-------------------------------------------------------------------------------------------------- +! threshold stress or slip resistance for screw dislocation motion + forall (s = 1_pInt:ns) & + plasticState(ph)%state(6_pInt*ns+nt+s, of) = & + lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)*& + sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& + plastic_titanmod_interactionMatrix_es(1:ns,s,instance))+ & + dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& + plastic_titanmod_interactionMatrix_ss(1:ns,s,instance))) +!-------------------------------------------------------------------------------------------------- +! threshold stress or slip resistance for dislocation motion in twin + forall (t = 1_pInt:nt) & + plasticState(ph)%state(7_pInt*ns+nt+t, of) = & + lattice_mu(ph)*plastic_titanmod_burgersPerTwinSys(t,instance)*& + (dot_product((abs(plasticState(ph)%state(2_pInt*ns+1_pInt:2_pInt*ns+nt, of))),& + plastic_titanmod_interactionMatrixTwinTwin(1:nt,t,instance))) + +! state=tempState + +end subroutine plastic_titanmod_microstructure + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,temperature,ipc,ip,el) + use math, only: & + math_Plain3333to99, & + math_Mandel6to33 + use lattice, only: & + lattice_Sslip, & + lattice_Sslip_v, & + lattice_Stwin, & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem, & + lattice_structure, & + LATTICE_hex_ID + use material, only: & + material_phase, & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + + implicit none + 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 + + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), intent(in) :: & + temperature !< temperature at IP + integer(pInt) :: & + index_myFamily, instance, & + ns,nt, & + f,i,j,k,l,m,n, & + ph, & + of + real(pReal) :: sumf, & + StressRatio_edge_p, minusStressRatio_edge_p, StressRatio_edge_pminus1, BoltzmannRatioedge, & + StressRatio_screw_p, minusStressRatio_screw_p, StressRatio_screw_pminus1, BoltzmannRatioscrew, & + 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(plastic_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 + real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_twin,dgdot_dtautwin,tau_twin, volumefraction_PerTwinSys + +! tempState=state + + + +!-------------------------------------------------------------------------------------------------- +! shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_titanmod_totalNslip(instance) + nt = plastic_titanmod_totalNtwin(instance) + + do i=1_pInt,nt + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & + plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) + + enddo + + sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 + + + Lp = 0.0_pReal + dLp_dTstar3333 = 0.0_pReal + dLp_dTstar99 = 0.0_pReal + + !* Dislocation glide part + gdot_slip = 0.0_pReal + gdot_slip_edge = 0.0_pReal + gdot_slip_screw = 0.0_pReal + dgdot_dtauslip = 0.0_pReal + j = 0_pInt + slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_titanmod_Nslip(f,instance) ! process each (active) slip system in family + j = j+1_pInt + + !* Calculation of Lp + !* Resolved shear stress on slip system + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + if(lattice_structure(ph)==LATTICE_hex_ID) then ! only for prismatic and pyr systems in hex + screwvelocity_prefactor=plastic_titanmod_debyefrequency(instance)* & + plasticState(ph)%state(4_pInt*ns+nt+j, of)*(plastic_titanmod_burgersPerSlipSys(j,instance)/ & + plastic_titanmod_kinkcriticallength_PerSlipSys(j,instance))**2 + + !* Stress ratio for screw ! No slip resistance for screw dislocations, only Peierls stress + bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance) + StressRatio_screw_p = ((abs(tau_slip(j)))/ & + ( bottomstress_screw) & + )**plastic_titanmod_ps_PerSlipSys(j,instance) + + if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then + minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p + else + minusStressRatio_screw_p=0.001_pReal + endif + + bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance) + StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/ & + ( bottomstress_screw) & + )**(plastic_titanmod_ps_PerSlipSys(j,instance)-1.0_pReal) + + !* Boltzmann ratio for screw + BoltzmannRatioscrew = plastic_titanmod_kinkf0(instance)/(kB*Temperature) + + else ! if the structure is not hex or the slip family is basal + screwvelocity_prefactor=plastic_titanmod_v0s_PerSlipSys(j,instance) + bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance)+ & + plasticState(ph)%state(6*ns+nt+j, of) + StressRatio_screw_p = ((abs(tau_slip(j)))/( bottomstress_screw ))**plastic_titanmod_ps_PerSlipSys(j,instance) + + if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then + minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p + else + minusStressRatio_screw_p=0.001_pReal + endif + + StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/( bottomstress_screw))** & + (plastic_titanmod_ps_PerSlipSys(j,instance)-1.0_pReal) + + !* Boltzmann ratio for screw + BoltzmannRatioscrew = plastic_titanmod_f0_PerSlipSys(j,instance)/(kB*Temperature) + + endif + + !* Stress ratio for edge + bottomstress_edge=plastic_titanmod_tau0e_PerSlipSys(j,instance)+ & + plasticState(ph)%state(5*ns+nt+j, of) + StressRatio_edge_p = ((abs(tau_slip(j)))/ & + ( bottomstress_edge) & + )**plastic_titanmod_pe_PerSlipSys(j,instance) + + if((1.0_pReal-StressRatio_edge_p)>0.001_pReal) then + minusStressRatio_edge_p=1.0_pReal-StressRatio_edge_p + else + minusStressRatio_edge_p=0.001_pReal + endif + + StressRatio_edge_pminus1 = ((abs(tau_slip(j)))/( bottomstress_edge))** & + (plastic_titanmod_pe_PerSlipSys(j,instance)-1.0_pReal) + + !* Boltzmann ratio for edge. For screws it is defined above + BoltzmannRatioedge = plastic_titanmod_f0_PerSlipSys(j,instance)/(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)** & + plastic_titanmod_qs_PerSlipSys(j,instance)) + + edge_velocity(j) =plastic_titanmod_v0e_PerSlipSys(j,instance)*exp(-BoltzmannRatioedge* & + (minusStressRatio_edge_p)** & + plastic_titanmod_qe_PerSlipSys(j,instance)) + + !* Shear rates due to edge slip + gdot_slip_edge(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(j, of)* & + edge_velocity(j))* sign(1.0_pReal,tau_slip(j)) + !* Shear rates due to screw slip + gdot_slip_screw(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(ns+j, of) * & + screw_velocity(j))* sign(1.0_pReal,tau_slip(j)) + !Total shear rate + + gdot_slip(j) = gdot_slip_edge(j) + gdot_slip_screw(j) + + plasticState(ph)%state( 7*ns+2*nt+j, of)= edge_velocity(j) + plasticState(ph)%state( 8*ns+2*nt+j, of)= screw_velocity(j) + plasticState(ph)%state( 9*ns+2*nt+j, of)= tau_slip(j) + plasticState(ph)%state(10*ns+2*nt+j, of)= gdot_slip_edge(j) + plasticState(ph)%state(11*ns+2*nt+j, of)= gdot_slip_screw(j) + plasticState(ph)%state(12*ns+2*nt+j, of)= StressRatio_edge_p + plasticState(ph)%state(13*ns+2*nt+j, of)= StressRatio_screw_p + + !* Derivatives of shear rates + dgdot_dtauslip(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(( & + ( & + ( & + ( & + (edge_velocity(j)*plasticState(ph)%state(j, of))) * & + BoltzmannRatioedge*& + plastic_titanmod_pe_PerSlipSys(j,instance)* & + plastic_titanmod_qe_PerSlipSys(j,instance) & + )/ & + bottomstress_edge & + )*& + StressRatio_edge_pminus1*(minusStressRatio_edge_p)** & + (plastic_titanmod_qe_PerSlipSys(j,instance)-1.0_pReal) & + ) + & + ( & + ( & + ( & + (plasticState(ph)%state(ns+j, of) * screw_velocity(j)) * & + BoltzmannRatioscrew* & + plastic_titanmod_ps_PerSlipSys(j,instance)* & + plastic_titanmod_qs_PerSlipSys(j,instance) & + )/ & + bottomstress_screw & + )*& + StressRatio_screw_pminus1*(minusStressRatio_screw_p)**(plastic_titanmod_qs_PerSlipSys(j,instance)-1.0_pReal) & + ) & + ) !* sign(1.0_pReal,tau_slip(j)) + + + +!************************************************* +!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,ph) + + !* Calculation of the tangent of Lp + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtauslip(j)*& + lattice_Sslip(k,l,1,index_myFamily+i,ph)*& + lattice_Sslip(m,n,1,index_myFamily+i,ph) + enddo + enddo slipFamiliesLoop + +!* Mechanical twinning part + gdot_twin = 0.0_pReal + dgdot_dtautwin = 0.0_pReal + j = 0_pInt + twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_titanmod_Ntwin(f,instance) ! process each (active) slip system in family + j = j+1_pInt + + !* Calculation of Lp + !* Resolved shear stress on twin system + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + +!************************************************************************************** + !* Stress ratios +! StressRatio_r = (plasticState(ph)%state6*ns+3*nt+j, of)/tau_twin(j))**plastic_titanmod_r(instance) + + !* Shear rates and their derivatives due to twin +! if ( tau_twin(j) > 0.0_pReal ) !then +! gdot_twin(j) = 0.0_pReal!& +! (plastic_titanmod_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& +! plasticState(ph)%state(6*ns+4*nt+j, of)*plastic_titanmod_Ndot0PerTwinSys(f,instance)*exp(-StressRatio_r) +! dgdot_dtautwin(j) = ((gdot_twin(j)*plastic_titanmod_r(instance))/tau_twin(j))*StressRatio_r +! endif +!************************************************************************************** + + !* Stress ratio for edge + twinStressRatio_p = ((abs(tau_twin(j)))/ & + ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & + )**plastic_titanmod_twinp_PerTwinSys(j,instance) + + if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then + twinminusStressRatio_p=1.0_pReal-twinStressRatio_p + else + twinminusStressRatio_p=0.001_pReal + endif + + twinStressRatio_pminus1 = ((abs(tau_twin(j)))/ & + ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & + )**(plastic_titanmod_twinp_PerTwinSys(j,instance)-1.0_pReal) + + !* Boltzmann ratio + BoltzmannRatiotwin = plastic_titanmod_twinf0_PerTwinSys(j,instance)/(kB*Temperature) + + !* Initial twin shear rates + TwinDotGamma0 = & + plastic_titanmod_twingamma0_PerTwinSys(j,instance) + + !* Shear rates due to twin + gdot_twin(j) =sign(1.0_pReal,tau_twin(j))*plastic_titanmod_twingamma0_PerTwinSys(j,instance)* & + exp(-BoltzmannRatiotwin*(twinminusStressRatio_p)**plastic_titanmod_twinq_PerTwinSys(j,instance)) + + + !* Derivatives of shear rates in twin + dgdot_dtautwin(j) = ( & + ( & + ( & + (abs(gdot_twin(j))) * & + BoltzmannRatiotwin*& + plastic_titanmod_twinp_PerTwinSys(j,instance)* & + plastic_titanmod_twinq_PerTwinSys(j,instance) & + )/ & + plastic_titanmod_twintau0_PerTwinSys(j,instance) & + )*& + twinStressRatio_pminus1*(twinminusStressRatio_p)** & + (plastic_titanmod_twinq_PerTwinSys(j,instance)-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,ph) + Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) + + !* Calculation of the tangent of Lp + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin(j)*& + lattice_Stwin(k,l,index_myFamily+i,ph)*& + lattice_Stwin(m,n,index_myFamily+i,ph) + enddo + enddo twinFamiliesLoop + +dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) +! tempState=state + + +end subroutine plastic_titanmod_LpAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_titanmod_dotState(Tstar_v,temperature,ipc,ip,el) + use lattice, only: & + lattice_Stwin_v, & + lattice_maxNslipFamily, & + lattice_maxNtwinFamily, & + lattice_NslipSystem, & + lattice_NtwinSystem + use material, only: & + material_phase, & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + +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 + + integer(pInt) :: & + index_myFamily, instance, & + ns,nt,& + f,i,j, & + ph, & + of + real(pReal) :: & + sumf,BoltzmannRatio, & + twinStressRatio_p,twinminusStressRatio_p + real(pReal), dimension(plastic_titanmod_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + DotRhoEdgeGeneration, & + DotRhoEdgeAnnihilation, & + DotRhoScrewGeneration, & + DotRhoScrewAnnihilation + real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_twin, & + tau_twin, & + volumefraction_PerTwinSys + +!-------------------------------------------------------------------------------------------------- +! shortened notation + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_titanmod_totalNslip(instance) + nt = plastic_titanmod_totalNtwin(instance) + do i=1_pInt,nt + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & + plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) + + enddo + + sumf = sum(abs(volumefraction_PerTwinSys(1_pInt:nt))) ! safe for nt == 0 + + plasticState(ph)%dotState(:,of) = 0.0_pReal + j = 0_pInt + slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_titanmod_Nslip(f,instance) ! process each (active) slip system in family + j = j+1_pInt + + DotRhoEdgeGeneration(j) = & ! multiplication of edge dislocations + plasticState(ph)%state(ns+j, of)*plasticState(ph)%state(8*ns+2*nt+j, of)/plasticState(ph)%state(4*ns+nt+j, of) + DotRhoScrewGeneration(j) = & ! multiplication of screw dislocations + plasticState(ph)%state(j, of)*plasticState(ph)%state(7*ns+2*nt+j, of)/plasticState(ph)%state(3*ns+nt+j, of) + DotRhoEdgeAnnihilation(j) = -((plasticState(ph)%state(j, of))**2)* & ! annihilation of edge dislocations + plastic_titanmod_capre_PerSlipSys(j,instance)*plasticState(ph)%state(7*ns+2*nt+j, of)*0.5_pReal + DotRhoScrewAnnihilation(j) = -((plasticState(ph)%state(ns+j, of))**2)* & ! annihilation of screw dislocations + plastic_titanmod_caprs_PerSlipSys(j,instance)*plasticState(ph)%state(8*ns+2*nt+j, of)*0.5_pReal + plasticState(ph)%dotState(j, of) = & ! edge dislocation density rate of change + DotRhoEdgeGeneration(j)+DotRhoEdgeAnnihilation(j) + + plasticState(ph)%dotState(ns+j, of) = & ! screw dislocation density rate of change + DotRhoScrewGeneration(j)+DotRhoScrewAnnihilation(j) + + plasticState(ph)%dotState(2*ns+j, of) = & ! sum of shear due to edge and screw + plasticState(ph)%state(10*ns+2*nt+j, of)+plasticState(ph)%state(11*ns+2*nt+j, of) + enddo + enddo slipFamiliesLoop + +!* Twin fraction evolution + j = 0_pInt + twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family + do i = 1_pInt,plastic_titanmod_Ntwin(f,instance) ! process each (active) twin system in family + j = j+1_pInt + + !* Resolved shear stress on twin system + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) + + !* Stress ratio for edge + twinStressRatio_p = ((abs(tau_twin(j)))/ & + ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & + )**(plastic_titanmod_twinp_PerTwinSys(j,instance)) + + + if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then + twinminusStressRatio_p=1.0_pReal-twinStressRatio_p + else + twinminusStressRatio_p=0.001_pReal + endif + + BoltzmannRatio = plastic_titanmod_twinf0_PerTwinSys(j,instance)/(kB*Temperature) + + gdot_twin(j) =plastic_titanmod_twingamma0_PerTwinSys(j,instance)*exp(-BoltzmannRatio* & + (twinminusStressRatio_p)** & + plastic_titanmod_twinq_PerTwinSys(j,instance))*sign(1.0_pReal,tau_twin(j)) + + plasticState(ph)%dotState(3*ns+j, of)=gdot_twin(j) + + enddo + enddo twinFamiliesLoop + +end subroutine plastic_titanmod_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_titanmod_postResults(ipc,ip,el) + use material, only: & + material_phase, & + phase_plasticityInstance, & + plasticState, & + phaseAt, phasememberAt + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(plastic_titanmod_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_titanmod_postResults + + integer(pInt) :: & + instance, & + ns,nt,& + o,i,c, & + ph, & + of + real(pReal) :: sumf + + real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + volumefraction_PerTwinSys + +!-------------------------------------------------------------------------------------------------- +! shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_titanmod_totalNslip(instance) + nt = plastic_titanmod_totalNtwin(instance) + + do i=1_pInt,nt + volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & + plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) + enddo + + sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 + + +!-------------------------------------------------------------------------------------------------- +! required output + c = 0_pInt + plastic_titanmod_postResults = 0.0_pReal + + do o = 1_pInt,plastic_titanmod_Noutput(instance) + select case(plastic_titanmod_outputID(o,instance)) + case (rhoedge_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(1_pInt:ns, of) + c = c + ns + case (rhoscrew_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of) + c = c + ns + case (segment_edge_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(3_pInt*ns+nt+1_pInt:4_pInt*ns+nt, of) + c = c + ns + case (segment_screw_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(4_pInt*ns+nt+1_pInt:5_pInt*ns+nt, of) + c = c + ns + case (resistance_edge_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(5_pInt*ns+nt+1_pInt:6_pInt*ns+nt, of) + c = c + ns + case (resistance_screw_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(6_pInt*ns+nt+1_pInt:7_pInt*ns+nt, of) + c = c + ns + case (velocity_edge_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(7*ns+2*nt+1:8*ns+2*nt, of) + c = c + ns + case (velocity_screw_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(8*ns+2*nt+1:9*ns+2*nt, of) + c = c + ns + case (tau_slip_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(9*ns+2*nt+1:10*ns+2*nt, of)) + c = c + ns + case (gdot_slip_edge_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) + c = c + ns + case (gdot_slip_screw_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) + c = c + ns + case (gdot_slip_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) + & + abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) + c = c + ns + case (stressratio_edge_p_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(12*ns+2*nt+1:13*ns+2*nt, of)) + c = c + ns + case (stressratio_screw_p_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(13*ns+2*nt+1:14*ns+2*nt, of)) + c = c + ns + case (shear_system_ID) + plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(2*ns+1:3*ns, of)) + c = c + ns + case (shear_basal_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:2*ns+3, of))) + c = c + 1_pInt + case (shear_prism_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+4:2*ns+6, of))) + c = c + 1_pInt + case (shear_pyra_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+7:2*ns+12, of))) + c = c + 1_pInt + case (shear_pyrca_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+13:2*ns+24, of))) + c = c + 1_pInt + + case (rhoedge_basal_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(1:3, of)) + c = c + 1_pInt + case (rhoedge_prism_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(4:6, of)) + c = c + 1_pInt + case (rhoedge_pyra_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(7:12,of)) + c = c + 1_pInt + case (rhoedge_pyrca_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(13:24, of)) + c = c + 1_pInt + + case (rhoscrew_basal_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+1:ns+3, of)) + c = c + 1_pInt + case (rhoscrew_prism_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+4:ns+6, of)) + c = c + 1_pInt + case (rhoscrew_pyra_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+7:ns+12, of)) + c = c + 1_pInt + case (rhoscrew_pyrca_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+13:ns+24, of)) + c = c + 1_pInt + case (shear_total_ID) + plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:3*ns, of))) + c = c + 1_pInt + case (twin_fraction_ID) + plastic_titanmod_postResults(c+1_pInt:c+nt) = abs(volumefraction_PerTwinSys(1:nt)) + c = c + nt + end select + enddo + +end function plastic_titanmod_postResults + +end module plastic_titanmod diff --git a/code/porosity/CMakeLists.txt b/code/porosity/CMakeLists.txt new file mode 100644 index 000000000..0695a1bf5 --- /dev/null +++ b/code/porosity/CMakeLists.txt @@ -0,0 +1,9 @@ +# group sources +set (POROSITY "porosity_none" + "porosity_phasefield" + ) + +# compile porosity modules +foreach (p ${POROSITY}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) diff --git a/code/porosity/porosity_none.f90 b/code/porosity/porosity_none.f90 new file mode 100644 index 000000000..69f10a5c6 --- /dev/null +++ b/code/porosity/porosity_none.f90 @@ -0,0 +1,61 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for constant porosity +!-------------------------------------------------------------------------------------------------- +module porosity_none + + implicit none + private + + public :: & + porosity_none_init + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, reads information from material configuration file +!-------------------------------------------------------------------------------------------------- +subroutine porosity_none_init() + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + pReal, & + pInt + use IO, only: & + IO_timeStamp + use material + use numerics, only: & + worldrank + + implicit none + integer(pInt) :: & + homog, & + NofMyHomog + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_none_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + initializeInstances: do homog = 1_pInt, material_Nhomogenization + + myhomog: if (porosity_type(homog) == POROSITY_none_ID) then + NofMyHomog = count(material_homog == homog) + porosityState(homog)%sizeState = 0_pInt + porosityState(homog)%sizePostResults = 0_pInt + allocate(porosityState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(porosityState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) + allocate(porosityState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) + + deallocate(porosity(homog)%p) + allocate (porosity(homog)%p(1), source=porosity_initialPhi(homog)) + + endif myhomog + enddo initializeInstances + + +end subroutine porosity_none_init + +end module porosity_none diff --git a/code/porosity/porosity_phasefield.f90 b/code/porosity/porosity_phasefield.f90 new file mode 100644 index 000000000..dc8b82b76 --- /dev/null +++ b/code/porosity/porosity_phasefield.f90 @@ -0,0 +1,450 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for phase field modelling of pore nucleation and growth +!> @details phase field model for pore nucleation and growth based on vacancy clustering +!-------------------------------------------------------------------------------------------------- +module porosity_phasefield + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + porosity_phasefield_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + porosity_phasefield_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + porosity_phasefield_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + porosity_phasefield_Noutput !< number of outputs per instance of this porosity + + enum, bind(c) + enumerator :: undefined_ID, & + porosity_ID + end enum + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + porosity_phasefield_outputID !< ID of each post result output + + + public :: & + porosity_phasefield_init, & + porosity_phasefield_getFormationEnergy, & + porosity_phasefield_getSurfaceEnergy, & + porosity_phasefield_getSourceAndItsTangent, & + porosity_phasefield_getDiffusion33, & + porosity_phasefield_getMobility, & + porosity_phasefield_putPorosity, & + porosity_phasefield_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine porosity_phasefield_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + porosity_type, & + porosity_typeInstance, & + homogenization_Noutput, & + POROSITY_phasefield_label, & + POROSITY_phasefield_ID, & + material_homog, & + mappingHomogenization, & + porosityState, & + porosityMapping, & + porosity, & + porosity_initialPhi, & + material_partHomogenization, & + material_partPhase + use numerics,only: & + worldrank + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o + integer(pInt) :: sizeState + integer(pInt) :: NofMyHomog + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt) + if (maxNinstance == 0_pInt) return + + allocate(porosity_phasefield_sizePostResults(maxNinstance), source=0_pInt) + allocate(porosity_phasefield_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(porosity_phasefield_output (maxval(homogenization_Noutput),maxNinstance)) + porosity_phasefield_output = '' + allocate(porosity_phasefield_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) + allocate(porosity_phasefield_Noutput (maxNinstance), source=0_pInt) + + rewind(fileUnit) + section = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to + line = IO_read(fileUnit) + enddo + + parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next homog section + section = section + 1_pInt ! advance homog section counter + cycle ! skip to next line + endif + + if (section > 0_pInt ) then; if (porosity_type(section) == POROSITY_phasefield_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = porosity_typeInstance(section) ! which instance of my porosity is present homog + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('porosity') + porosity_phasefield_Noutput(instance) = porosity_phasefield_Noutput(instance) + 1_pInt + porosity_phasefield_outputID(porosity_phasefield_Noutput(instance),instance) = porosity_ID + porosity_phasefield_output(porosity_phasefield_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + end select + endif; endif + enddo parsingHomog + + initializeInstances: do section = 1_pInt, size(porosity_type) + if (porosity_type(section) == POROSITY_phasefield_ID) then + NofMyHomog=count(material_homog==section) + instance = porosity_typeInstance(section) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,porosity_phasefield_Noutput(instance) + select case(porosity_phasefield_outputID(o,instance)) + case(porosity_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + porosity_phasefield_sizePostResult(o,instance) = mySize + porosity_phasefield_sizePostResults(instance) = porosity_phasefield_sizePostResults(instance) + mySize + endif + enddo outputsLoop + +! allocate state arrays + sizeState = 0_pInt + porosityState(section)%sizeState = sizeState + porosityState(section)%sizePostResults = porosity_phasefield_sizePostResults(instance) + allocate(porosityState(section)%state0 (sizeState,NofMyHomog)) + allocate(porosityState(section)%subState0(sizeState,NofMyHomog)) + allocate(porosityState(section)%state (sizeState,NofMyHomog)) + + nullify(porosityMapping(section)%p) + porosityMapping(section)%p => mappingHomogenization(1,:,:) + deallocate(porosity(section)%p) + allocate(porosity(section)%p(NofMyHomog), source=porosity_initialPhi(section)) + + endif + + enddo initializeInstances +end subroutine porosity_phasefield_init + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized vacancy formation energy +!-------------------------------------------------------------------------------------------------- +function porosity_phasefield_getFormationEnergy(ip,el) + use lattice, only: & + lattice_vacancyFormationEnergy, & + lattice_vacancyVol + use material, only: & + homogenization_Ngrains, & + material_phase + use mesh, only: & + mesh_element + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal) :: & + porosity_phasefield_getFormationEnergy + integer(pInt) :: & + grain + + porosity_phasefield_getFormationEnergy = 0.0_pReal + do grain = 1, homogenization_Ngrains(mesh_element(3,el)) + porosity_phasefield_getFormationEnergy = porosity_phasefield_getFormationEnergy + & + lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ & + lattice_vacancyVol(material_phase(grain,ip,el)) + enddo + + porosity_phasefield_getFormationEnergy = & + porosity_phasefield_getFormationEnergy/ & + homogenization_Ngrains(mesh_element(3,el)) + +end function porosity_phasefield_getFormationEnergy + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized pore surface energy (normalized by characteristic length) +!-------------------------------------------------------------------------------------------------- +function porosity_phasefield_getSurfaceEnergy(ip,el) + use lattice, only: & + lattice_vacancySurfaceEnergy + use material, only: & + homogenization_Ngrains, & + material_phase + use mesh, only: & + mesh_element + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal) :: & + porosity_phasefield_getSurfaceEnergy + integer(pInt) :: & + grain + + porosity_phasefield_getSurfaceEnergy = 0.0_pReal + do grain = 1, homogenization_Ngrains(mesh_element(3,el)) + porosity_phasefield_getSurfaceEnergy = porosity_phasefield_getSurfaceEnergy + & + lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) + enddo + + porosity_phasefield_getSurfaceEnergy = & + porosity_phasefield_getSurfaceEnergy/ & + homogenization_Ngrains(mesh_element(3,el)) + +end function porosity_phasefield_getSurfaceEnergy + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates homogenized local driving force for pore nucleation and growth +!-------------------------------------------------------------------------------------------------- +subroutine porosity_phasefield_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) + use math, only : & + math_mul33x33, & + math_mul66x6, & + math_Mandel33to6, & + math_transpose33, & + math_I3 + use material, only: & + homogenization_Ngrains, & + material_homog, & + material_phase, & + phase_NstiffnessDegradations, & + phase_stiffnessDegradation, & + vacancyConc, & + vacancyfluxMapping, & + damage, & + damageMapping, & + STIFFNESS_DEGRADATION_damage_ID + use crystallite, only: & + crystallite_Fe + use constitutive, only: & + constitutive_homogenizedC + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer(pInt) :: & + phase, & + grain, & + homog, & + mech + real(pReal) :: & + phiDot, dPhiDot_dPhi, Cv, W_e, strain(6), C(6,6) + + homog = material_homog(ip,el) + Cv = vacancyConc(homog)%p(vacancyfluxMapping(homog)%p(ip,el)) + + W_e = 0.0_pReal + do grain = 1, homogenization_Ngrains(homog) + phase = material_phase(grain,ip,el) + strain = math_Mandel33to6(math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,grain,ip,el)), & + crystallite_Fe(1:3,1:3,grain,ip,el)) - math_I3)/2.0_pReal + C = constitutive_homogenizedC(grain,ip,el) + do mech = 1_pInt, phase_NstiffnessDegradations(phase) + select case(phase_stiffnessDegradation(mech,phase)) + case (STIFFNESS_DEGRADATION_damage_ID) + C = damage(homog)%p(damageMapping(homog)%p(ip,el))* & + damage(homog)%p(damageMapping(homog)%p(ip,el))* & + C + + end select + enddo + W_e = W_e + sum(abs(strain*math_mul66x6(C,strain))) + enddo + W_e = W_e/homogenization_Ngrains(homog) + + phiDot = 2.0_pReal*(1.0_pReal - phi)*(1.0_pReal - Cv)*(1.0_pReal - Cv) - & + 2.0_pReal*phi*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ & + porosity_phasefield_getSurfaceEnergy (ip,el) + dPhiDot_dPhi = - 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - Cv) & + - 2.0_pReal*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ & + porosity_phasefield_getSurfaceEnergy (ip,el) + +end subroutine porosity_phasefield_getSourceAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized nonlocal diffusion tensor in reference configuration +!-------------------------------------------------------------------------------------------------- +function porosity_phasefield_getDiffusion33(ip,el) + use lattice, only: & + lattice_PorosityDiffusion33 + use material, only: & + homogenization_Ngrains, & + material_phase, & + mappingHomogenization + use crystallite, only: & + crystallite_push33ToRef + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + porosity_phasefield_getDiffusion33 + integer(pInt) :: & + homog, & + grain + + homog = mappingHomogenization(2,ip,el) + porosity_phasefield_getDiffusion33 = 0.0_pReal + do grain = 1, homogenization_Ngrains(homog) + porosity_phasefield_getDiffusion33 = porosity_phasefield_getDiffusion33 + & + crystallite_push33ToRef(grain,ip,el,lattice_PorosityDiffusion33(1:3,1:3,material_phase(grain,ip,el))) + enddo + + porosity_phasefield_getDiffusion33 = & + porosity_phasefield_getDiffusion33/ & + homogenization_Ngrains(homog) + +end function porosity_phasefield_getDiffusion33 + +!-------------------------------------------------------------------------------------------------- +!> @brief Returns homogenized phase field mobility +!-------------------------------------------------------------------------------------------------- +real(pReal) function porosity_phasefield_getMobility(ip,el) + use mesh, only: & + mesh_element + use lattice, only: & + lattice_PorosityMobility + use material, only: & + material_phase, & + homogenization_Ngrains + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + integer(pInt) :: & + ipc + + porosity_phasefield_getMobility = 0.0_pReal + + do ipc = 1, homogenization_Ngrains(mesh_element(3,el)) + porosity_phasefield_getMobility = porosity_phasefield_getMobility + lattice_PorosityMobility(material_phase(ipc,ip,el)) + enddo + + porosity_phasefield_getMobility = porosity_phasefield_getMobility/homogenization_Ngrains(mesh_element(3,el)) + +end function porosity_phasefield_getMobility + +!-------------------------------------------------------------------------------------------------- +!> @brief updates porosity with solution from phasefield PDE +!-------------------------------------------------------------------------------------------------- +subroutine porosity_phasefield_putPorosity(phi,ip,el) + use material, only: & + material_homog, & + porosityMapping, & + porosity + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer(pInt) :: & + homog, & + offset + + homog = material_homog(ip,el) + offset = porosityMapping(homog)%p(ip,el) + porosity(homog)%p(offset) = phi + +end subroutine porosity_phasefield_putPorosity + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of porosity results +!-------------------------------------------------------------------------------------------------- +function porosity_phasefield_postResults(ip,el) + use material, only: & + mappingHomogenization, & + porosity_typeInstance, & + porosity + + implicit none + integer(pInt), intent(in) :: & + ip, & !< integration point + el !< element + real(pReal), dimension(porosity_phasefield_sizePostResults(porosity_typeInstance(mappingHomogenization(2,ip,el)))) :: & + porosity_phasefield_postResults + + integer(pInt) :: & + instance, homog, offset, o, c + + homog = mappingHomogenization(2,ip,el) + offset = mappingHomogenization(1,ip,el) + instance = porosity_typeInstance(homog) + + c = 0_pInt + porosity_phasefield_postResults = 0.0_pReal + + do o = 1_pInt,porosity_phasefield_Noutput(instance) + select case(porosity_phasefield_outputID(o,instance)) + + case (porosity_ID) + porosity_phasefield_postResults(c+1_pInt) = porosity(homog)%p(offset) + c = c + 1 + end select + enddo +end function porosity_phasefield_postResults + +end module porosity_phasefield diff --git a/code/source/CMakeLists.txt b/code/source/CMakeLists.txt new file mode 100644 index 000000000..fa54f332a --- /dev/null +++ b/code/source/CMakeLists.txt @@ -0,0 +1,16 @@ +# group source +set (SOURCE "source_thermal_dissipation" + "source_thermal_externalheat" + "source_damage_isoBrittle" + "source_damage_isoDuctile" + "source_damage_anisoBrittle" + "source_damage_anisoDuctile" + "source_vacancy_phenoplasticity" + "source_vacancy_irradiation" + "source_vacancy_thermalfluc" + ) + +# compile modules for source +foreach (p ${SOURCE}) + add_library (${p} MODULE "${p}.f90") +endforeach (p) diff --git a/code/source/source_damage_anisoBrittle.f90 b/code/source/source_damage_anisoBrittle.f90 new file mode 100644 index 000000000..a751eefdc --- /dev/null +++ b/code/source/source_damage_anisoBrittle.f90 @@ -0,0 +1,425 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Luv Sharma, Max-Planck-Institut fŸr Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut fŸr Eisenforschung GmbH +!> @brief material subroutine incorporating anisotropic brittle damage source mechanism +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_damage_anisoBrittle + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_damage_anisoBrittle_sizePostResults, & !< cumulative size of post results + source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? + source_damage_anisoBrittle_instance !< instance of source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_damage_anisoBrittle_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_damage_anisoBrittle_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_damage_anisoBrittle_Noutput !< number of outputs per instance of this source + + integer(pInt), dimension(:), allocatable, private :: & + source_damage_anisoBrittle_totalNcleavage !< total number of cleavage systems + + integer(pInt), dimension(:,:), allocatable, private :: & + source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family + + real(pReal), dimension(:), allocatable, private :: & + source_damage_anisoBrittle_aTol, & + source_damage_anisoBrittle_sdot_0, & + source_damage_anisoBrittle_N + + real(pReal), dimension(:,:), allocatable, private :: & + source_damage_anisoBrittle_critDisp, & + source_damage_anisoBrittle_critLoad + + enum, bind(c) + enumerator :: undefined_ID, & + damage_drivingforce_ID + end enum + + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + source_damage_anisoBrittle_outputID !< ID of each post result output + + + public :: & + source_damage_anisoBrittle_init, & + source_damage_anisoBrittle_dotState, & + source_damage_anisobrittle_getRateAndItsTangent, & + source_damage_anisoBrittle_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_anisoBrittle_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_damage_anisoBrittle_label, & + SOURCE_damage_anisoBrittle_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + use lattice, only: & + lattice_maxNcleavageFamily, & + lattice_NcleavageSystem + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoBrittle_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0_pInt) + allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_damage_anisoBrittle_ID) & + source_damage_anisoBrittle_offset(phase) = source + enddo + enddo + + allocate(source_damage_anisoBrittle_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) + allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),maxNinstance)) + source_damage_anisoBrittle_output = '' + allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(source_damage_anisoBrittle_Noutput(maxNinstance), source=0_pInt) + allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt) + allocate(source_damage_anisoBrittle_totalNcleavage(maxNinstance), source=0_pInt) + allocate(source_damage_anisoBrittle_aTol(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_sdot_0(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_N(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = source_damage_anisoBrittle_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('anisobrittle_drivingforce') + source_damage_anisoBrittle_Noutput(instance) = source_damage_anisoBrittle_Noutput(instance) + 1_pInt + source_damage_anisoBrittle_outputID(source_damage_anisoBrittle_Noutput(instance),instance) = damage_drivingforce_ID + source_damage_anisoBrittle_output(source_damage_anisoBrittle_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + case ('anisobrittle_atol') + source_damage_anisoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('anisobrittle_sdot0') + source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('anisobrittle_ratesensitivity') + source_damage_anisoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('ncleavage') ! + Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_CleavageFamilies + source_damage_anisoBrittle_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisobrittle_criticaldisplacement') + do j = 1_pInt, Nchunks_CleavageFamilies + source_damage_anisoBrittle_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisobrittle_criticalload') + do j = 1_pInt, Nchunks_CleavageFamilies + source_damage_anisoBrittle_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + end select + endif; endif + enddo parsingFile + +!-------------------------------------------------------------------------------------------------- +! sanity checks + sanityChecks: do phase = 1_pInt, material_Nphase + myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then + instance = source_damage_anisoBrittle_instance(phase) + source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & + min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested + source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance)) + source_damage_anisoBrittle_totalNcleavage(instance) = sum(source_damage_anisoBrittle_Ncleavage(:,instance)) ! how many cleavage systems altogether + if (source_damage_anisoBrittle_aTol(instance) < 0.0_pReal) & + source_damage_anisoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 + if (source_damage_anisoBrittle_sdot_0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoBrittle_LABEL//')') + if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')') + if (any(source_damage_anisoBrittle_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//SOURCE_damage_anisoBrittle_LABEL//')') + if (source_damage_anisoBrittle_N(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoBrittle_LABEL//')') + endif myPhase + enddo sanityChecks + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance) + select case(source_damage_anisoBrittle_outputID(o,instance)) + case(damage_drivingforce_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + source_damage_anisoBrittle_sizePostResult(o,instance) = mySize + source_damage_anisoBrittle_sizePostResults(instance) = source_damage_anisoBrittle_sizePostResults(instance) + mySize + endif + enddo outputsLoop + +!-------------------------------------------------------------------------------------------------- +! Determine size of state array + sizeDotState = 1_pInt + sizeDeltaState = 0_pInt + sizeState = 1_pInt + + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & + source=source_damage_anisoBrittle_aTol(instance)) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_damage_anisoBrittle_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState, & + material_homog, & + damage, & + damageMapping + use lattice, only: & + lattice_Scleavage_v, & + lattice_maxNcleavageFamily, & + lattice_NcleavageSystem + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(6) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) + integer(pInt) :: & + phase, & + constituent, & + instance, & + sourceOffset, & + damageOffset, & + homog, & + f, i, index_myFamily + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) + homog = material_homog(ip,el) + damageOffset = damageMapping(homog)%p(ip,el) + + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal + do f = 1_pInt,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family + traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase)) + traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase)) + traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase)) + + traction_crit = source_damage_anisoBrittle_critLoad(f,instance)* & + damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & + source_damage_anisoBrittle_sdot_0(instance)* & + ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance))/ & + source_damage_anisoBrittle_critDisp(f,instance) + + enddo + enddo + +end subroutine source_damage_anisoBrittle_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + integer(pInt) :: & + phase, constituent, sourceOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + sourceOffset = source_damage_anisoBrittle_offset(phase) + + localphiDot = 1.0_pReal - & + sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi + + dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + +end subroutine source_damage_anisobrittle_getRateAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of local damage results +!-------------------------------------------------------------------------------------------------- +function source_damage_anisoBrittle_postResults(ipc,ip,el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(source_damage_anisoBrittle_sizePostResults( & + source_damage_anisoBrittle_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_anisoBrittle_postResults + + integer(pInt) :: & + instance, phase, constituent, sourceOffset, o, c + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) + + c = 0_pInt + source_damage_anisoBrittle_postResults = 0.0_pReal + + do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance) + select case(source_damage_anisoBrittle_outputID(o,instance)) + case (damage_drivingforce_ID) + source_damage_anisoBrittle_postResults(c+1_pInt) = & + sourceState(phase)%p(sourceOffset)%state(1,constituent) + c = c + 1_pInt + + end select + enddo +end function source_damage_anisoBrittle_postResults + +end module source_damage_anisoBrittle diff --git a/code/source/source_damage_anisoDuctile.f90 b/code/source/source_damage_anisoDuctile.f90 new file mode 100644 index 000000000..028fd479a --- /dev/null +++ b/code/source/source_damage_anisoDuctile.f90 @@ -0,0 +1,415 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incorporating anisotropic ductile damage source mechanism +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_damage_anisoDuctile + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_damage_anisoDuctile_sizePostResults, & !< cumulative size of post results + source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? + source_damage_anisoDuctile_instance !< instance of damage source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_damage_anisoDuctile_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_damage_anisoDuctile_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_damage_anisoDuctile_Noutput !< number of outputs per instance of this damage + + integer(pInt), dimension(:), allocatable, private :: & + source_damage_anisoDuctile_totalNslip !< total number of slip systems + + integer(pInt), dimension(:,:), allocatable, private :: & + source_damage_anisoDuctile_Nslip !< number of slip systems per family + + real(pReal), dimension(:), allocatable, private :: & + source_damage_anisoDuctile_aTol + + real(pReal), dimension(:,:), allocatable, private :: & + source_damage_anisoDuctile_critPlasticStrain + + real(pReal), dimension(:), allocatable, private :: & + source_damage_anisoDuctile_sdot_0, & + source_damage_anisoDuctile_N + + real(pReal), dimension(:,:), allocatable, private :: & + source_damage_anisoDuctile_critLoad + + enum, bind(c) + enumerator :: undefined_ID, & + damage_drivingforce_ID + end enum + + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + source_damage_anisoDuctile_outputID !< ID of each post result output + + + public :: & + source_damage_anisoDuctile_init, & + source_damage_anisoDuctile_dotState, & + source_damage_anisoDuctile_getRateAndItsTangent, & + source_damage_anisoDuctile_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_anisoDuctile_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_damage_anisoDuctile_label, & + SOURCE_damage_anisoDuctile_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + use lattice, only: & + lattice_maxNslipFamily, & + lattice_NslipSystem + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoDuctile_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_damage_anisoDuctile_offset(material_Nphase), source=0_pInt) + allocate(source_damage_anisoDuctile_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_damage_anisoDuctile_ID) & + source_damage_anisoDuctile_offset(phase) = source + enddo + enddo + + allocate(source_damage_anisoDuctile_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),maxNinstance)) + source_damage_anisoDuctile_output = '' + allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(source_damage_anisoDuctile_Noutput(maxNinstance), source=0_pInt) + allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) + allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(source_damage_anisoDuctile_totalNslip(maxNinstance), source=0_pInt) + allocate(source_damage_anisoDuctile_N(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_sdot_0(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_aTol(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = source_damage_anisoDuctile_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('anisoductile_drivingforce') + source_damage_anisoDuctile_Noutput(instance) = source_damage_anisoDuctile_Noutput(instance) + 1_pInt + source_damage_anisoDuctile_outputID(source_damage_anisoDuctile_Noutput(instance),instance) = damage_drivingforce_ID + source_damage_anisoDuctile_output(source_damage_anisoDuctile_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + case ('anisoductile_atol') + source_damage_anisoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('nslip') ! + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt + do j = 1_pInt, Nchunks_SlipFamilies + source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisoductile_sdot0') + source_damage_anisoDuctile_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('anisoductile_criticalplasticstrain') + do j = 1_pInt, Nchunks_SlipFamilies + source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + case ('anisoductile_ratesensitivity') + source_damage_anisoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('anisoductile_criticalload') + do j = 1_pInt, Nchunks_SlipFamilies + source_damage_anisoDuctile_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + + end select + endif; endif + enddo parsingFile + +!-------------------------------------------------------------------------------------------------- +! sanity checks + sanityChecks: do phase = 1_pInt, size(phase_source) + myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then + instance = source_damage_anisoDuctile_instance(phase) + source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance) = & + min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested + source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance)) + source_damage_anisoDuctile_totalNslip(instance) = sum(source_damage_anisoDuctile_Nslip(:,instance)) + if (source_damage_anisoDuctile_aTol(instance) < 0.0_pReal) & + source_damage_anisoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 + if (source_damage_anisoDuctile_sdot_0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoDuctile_LABEL//')') + if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) & + call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')') + if (source_damage_anisoDuctile_N(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoDuctile_LABEL//')') + endif myPhase + enddo sanityChecks + + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance) + select case(source_damage_anisoDuctile_outputID(o,instance)) + case(damage_drivingforce_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + source_damage_anisoDuctile_sizePostResult(o,instance) = mySize + source_damage_anisoDuctile_sizePostResults(instance) = source_damage_anisoDuctile_sizePostResults(instance) + mySize + endif + enddo outputsLoop + +!-------------------------------------------------------------------------------------------------- +! Determine size of state array + sizeDotState = 1_pInt + sizeDeltaState = 0_pInt + sizeState = 1_pInt + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & + source=source_damage_anisoDuctile_aTol(instance)) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_damage_anisoDuctile_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + plasticState, & + sourceState, & + material_homog, & + damage, & + damageMapping + use lattice, only: & + lattice_maxNslipFamily + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + integer(pInt) :: & + phase, & + constituent, & + sourceOffset, & + homog, damageOffset, & + instance, & + index, f, i + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + homog = material_homog(ip,el) + damageOffset = damageMapping(homog)%p(ip,el) + + index = 1_pInt + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal + do f = 1_pInt,lattice_maxNslipFamily + do i = 1_pInt,source_damage_anisoDuctile_Nslip(f,instance) ! process each (active) slip system in family + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & + plasticState(phase)%slipRate(index,constituent)/ & + ((damage(homog)%p(damageOffset))**source_damage_anisoDuctile_N(instance))/ & + source_damage_anisoDuctile_critPlasticStrain(f,instance) + + index = index + 1_pInt + enddo + enddo + +end subroutine source_damage_anisoDuctile_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + integer(pInt) :: & + phase, constituent, sourceOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + sourceOffset = source_damage_anisoDuctile_offset(phase) + + localphiDot = 1.0_pReal - & + sourceState(phase)%p(sourceOffset)%state(1,constituent)* & + phi + + dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + +end subroutine source_damage_anisoDuctile_getRateAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of local damage results +!-------------------------------------------------------------------------------------------------- +function source_damage_anisoDuctile_postResults(ipc,ip,el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(source_damage_anisoDuctile_sizePostResults( & + source_damage_anisoDuctile_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_anisoDuctile_postResults + + integer(pInt) :: & + instance, phase, constituent, sourceOffset, o, c + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + + c = 0_pInt + source_damage_anisoDuctile_postResults = 0.0_pReal + + do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance) + select case(source_damage_anisoDuctile_outputID(o,instance)) + case (damage_drivingforce_ID) + source_damage_anisoDuctile_postResults(c+1_pInt) = & + sourceState(phase)%p(sourceOffset)%state(1,constituent) + c = c + 1_pInt + + end select + enddo +end function source_damage_anisoDuctile_postResults + +end module source_damage_anisoDuctile diff --git a/code/source/source_damage_isoBrittle.f90 b/code/source/source_damage_isoBrittle.f90 new file mode 100644 index 000000000..c063ae86f --- /dev/null +++ b/code/source/source_damage_isoBrittle.f90 @@ -0,0 +1,383 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incoprorating isotropic brittle damage source mechanism +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_damage_isoBrittle + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_damage_isoBrittle_sizePostResults, & !< cumulative size of post results + source_damage_isoBrittle_offset, & !< which source is my current damage mechanism? + source_damage_isoBrittle_instance !< instance of damage source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_damage_isoBrittle_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_damage_isoBrittle_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage + + real(pReal), dimension(:), allocatable, private :: & + source_damage_isoBrittle_aTol, & + source_damage_isoBrittle_N, & + source_damage_isoBrittle_critStrainEnergy + + enum, bind(c) + enumerator :: undefined_ID, & + damage_drivingforce_ID + end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo + + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + source_damage_isoBrittle_outputID !< ID of each post result output + + + public :: & + source_damage_isoBrittle_init, & + source_damage_isoBrittle_deltaState, & + source_damage_isoBrittle_getRateAndItsTangent, & + source_damage_isoBrittle_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_isoBrittle_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_damage_isoBrittle_label, & + SOURCE_damage_isoBrittle_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoBrittle_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_damage_isoBrittle_offset(material_Nphase), source=0_pInt) + allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_damage_isoBrittle_ID) & + source_damage_isoBrittle_offset(phase) = source + enddo + enddo + + allocate(source_damage_isoBrittle_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),maxNinstance)) + source_damage_isoBrittle_output = '' + allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(source_damage_isoBrittle_Noutput(maxNinstance), source=0_pInt) + allocate(source_damage_isoBrittle_critStrainEnergy(maxNinstance), source=0.0_pReal) + allocate(source_damage_isoBrittle_N(maxNinstance), source=1.0_pReal) + allocate(source_damage_isoBrittle_aTol(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = source_damage_isoBrittle_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('isobrittle_drivingforce') + source_damage_isoBrittle_Noutput(instance) = source_damage_isoBrittle_Noutput(instance) + 1_pInt + source_damage_isoBrittle_outputID(source_damage_isoBrittle_Noutput(instance),instance) = damage_drivingforce_ID + source_damage_isoBrittle_output(source_damage_isoBrittle_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + case ('isobrittle_criticalstrainenergy') + source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('isobrittle_n') + source_damage_isoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('isobrittle_atol') + source_damage_isoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + + +!-------------------------------------------------------------------------------------------------- +! sanity checks + sanityChecks: do phase = 1_pInt, material_Nphase + myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then + instance = source_damage_isoBrittle_instance(phase) + if (source_damage_isoBrittle_aTol(instance) < 0.0_pReal) & + source_damage_isoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 + if (source_damage_isoBrittle_critStrainEnergy(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='criticalStrainEnergy ('//SOURCE_damage_isoBrittle_LABEL//')') + endif myPhase + enddo sanityChecks + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_damage_isoBrittle_instance(phase) + sourceOffset = source_damage_isoBrittle_offset(phase) +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,source_damage_isoBrittle_Noutput(instance) + select case(source_damage_isoBrittle_outputID(o,instance)) + case(damage_drivingforce_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + source_damage_isoBrittle_sizePostResult(o,instance) = mySize + source_damage_isoBrittle_sizePostResults(instance) = source_damage_isoBrittle_sizePostResults(instance) + mySize + endif + enddo outputsLoop +! Determine size of state array + sizeDotState = 1_pInt + sizeDeltaState = 1_pInt + sizeState = 1_pInt + + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & + source=source_damage_isoBrittle_aTol(instance)) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_damage_isoBrittle_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState, & + material_homog, & + phase_NstiffnessDegradations, & + phase_stiffnessDegradation, & + porosity, & + porosityMapping, & + STIFFNESS_DEGRADATION_porosity_ID + use math, only : & + math_mul33x33, & + math_mul66x6, & + math_Mandel33to6, & + math_transpose33, & + math_I3 + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + Fe + real(pReal), intent(in), dimension(6,6) :: & + C + integer(pInt) :: & + phase, constituent, instance, sourceOffset, mech + real(pReal) :: & + strain(6), & + stiffness(6,6), & + strainenergy + + phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el + constituent = phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el + ! ToDo: capability for multiple instances of SAME source within given phase. Needs Ninstance loop from here on! + instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source + sourceOffset = source_damage_isoBrittle_offset(phase) + + stiffness = C + do mech = 1_pInt, phase_NstiffnessDegradations(phase) + select case(phase_stiffnessDegradation(mech,phase)) + case (STIFFNESS_DEGRADATION_porosity_ID) + stiffness = porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* & + porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* & + stiffness + end select + enddo + strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3) + + strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ & + source_damage_isoBrittle_critStrainEnergy(instance) + if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then + sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) + else + sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - & + sourceState(phase)%p(sourceOffset)%state(1,constituent) + endif + +end subroutine source_damage_isoBrittle_deltaState + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + integer(pInt) :: & + phase, constituent, instance, sourceOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_isoBrittle_instance(phase) + sourceOffset = source_damage_isoBrittle_offset(phase) + + localphiDot = (1.0_pReal - phi)**(source_damage_isoBrittle_N(instance) - 1.0_pReal) - & + phi*sourceState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = - (source_damage_isoBrittle_N(instance) - 1.0_pReal)* & + (1.0_pReal - phi)**max(0.0_pReal,source_damage_isoBrittle_N(instance) - 2.0_pReal) & + - sourceState(phase)%p(sourceOffset)%state(1,constituent) + +end subroutine source_damage_isoBrittle_getRateAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of local damage results +!-------------------------------------------------------------------------------------------------- +function source_damage_isoBrittle_postResults(ipc,ip,el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(source_damage_isoBrittle_sizePostResults( & + source_damage_isoBrittle_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_isoBrittle_postResults + + integer(pInt) :: & + instance, phase, constituent, sourceOffset, o, c + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_isoBrittle_instance(phase) + sourceOffset = source_damage_isoBrittle_offset(phase) + + c = 0_pInt + source_damage_isoBrittle_postResults = 0.0_pReal + + do o = 1_pInt,source_damage_isoBrittle_Noutput(instance) + select case(source_damage_isoBrittle_outputID(o,instance)) + case (damage_drivingforce_ID) + source_damage_isoBrittle_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) + c = c + 1 + + end select + enddo +end function source_damage_isoBrittle_postResults + +end module source_damage_isoBrittle diff --git a/code/source/source_damage_isoDuctile.f90 b/code/source/source_damage_isoDuctile.f90 new file mode 100644 index 000000000..b0290264c --- /dev/null +++ b/code/source/source_damage_isoDuctile.f90 @@ -0,0 +1,350 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut fŸr Eisenforschung GmbH +!> @author Luv Sharma, Max-Planck-Institut fŸr Eisenforschung GmbH +!> @brief material subroutine incoprorating isotropic ductile damage source mechanism +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_damage_isoDuctile + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_damage_isoDuctile_sizePostResults, & !< cumulative size of post results + source_damage_isoDuctile_offset, & !< which source is my current damage mechanism? + source_damage_isoDuctile_instance !< instance of damage source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_damage_isoDuctile_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_damage_isoDuctile_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage + + real(pReal), dimension(:), allocatable, private :: & + source_damage_isoDuctile_aTol, & + source_damage_isoDuctile_critPlasticStrain, & + source_damage_isoDuctile_N + + enum, bind(c) + enumerator :: undefined_ID, & + damage_drivingforce_ID + end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo + + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + source_damage_isoDuctile_outputID !< ID of each post result output + + + public :: & + source_damage_isoDuctile_init, & + source_damage_isoDuctile_dotState, & + source_damage_isoDuctile_getRateAndItsTangent, & + source_damage_isoDuctile_postResults + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_isoDuctile_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_damage_isoDuctile_label, & + SOURCE_damage_isoDuctile_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoDuctile_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt) + allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_damage_isoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoDuctile_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_damage_isoDuctile_ID) & + source_damage_isoDuctile_offset(phase) = source + enddo + enddo + + allocate(source_damage_isoDuctile_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),maxNinstance)) + source_damage_isoDuctile_output = '' + allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) + allocate(source_damage_isoDuctile_Noutput(maxNinstance), source=0_pInt) + allocate(source_damage_isoDuctile_critPlasticStrain(maxNinstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_N(maxNinstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_aTol(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = source_damage_isoDuctile_instance(phase) ! which instance of my damage is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case ('isoductile_drivingforce') + source_damage_isoDuctile_Noutput(instance) = source_damage_isoDuctile_Noutput(instance) + 1_pInt + source_damage_isoDuctile_outputID(source_damage_isoDuctile_Noutput(instance),instance) = damage_drivingforce_ID + source_damage_isoDuctile_output(source_damage_isoDuctile_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + end select + + case ('isoductile_criticalplasticstrain') + source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('isoductile_ratesensitivity') + source_damage_isoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('isoductile_atol') + source_damage_isoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + + +!-------------------------------------------------------------------------------------------------- +! sanity checks + sanityChecks: do phase = 1_pInt, material_Nphase + myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then + instance = source_damage_isoDuctile_instance(phase) + if (source_damage_isoDuctile_aTol(instance) < 0.0_pReal) & + source_damage_isoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 + if (source_damage_isoDuctile_critPlasticStrain(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='critical plastic strain ('//SOURCE_damage_isoDuctile_LABEL//')') + endif myPhase + enddo sanityChecks + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_damage_isoDuctile_instance(phase) + sourceOffset = source_damage_isoDuctile_offset(phase) +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,source_damage_isoDuctile_Noutput(instance) + select case(source_damage_isoDuctile_outputID(o,instance)) + case(damage_drivingforce_ID) + mySize = 1_pInt + end select + + if (mySize > 0_pInt) then ! any meaningful output found + source_damage_isoDuctile_sizePostResult(o,instance) = mySize + source_damage_isoDuctile_sizePostResults(instance) = source_damage_isoDuctile_sizePostResults(instance) + mySize + endif + enddo outputsLoop +! Determine size of state array + sizeDotState = 1_pInt + sizeDeltaState = 0_pInt + sizeState = 1_pInt + + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & + source=source_damage_isoDuctile_aTol(instance)) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_damage_isoDuctile_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_isoDuctile_dotState(ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + plasticState, & + sourceState, & + material_homog, & + damage, & + damageMapping + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + integer(pInt) :: & + phase, constituent, instance, homog, sourceOffset, damageOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_isoDuctile_instance(phase) + sourceOffset = source_damage_isoDuctile_offset(phase) + homog = material_homog(ip,el) + damageOffset = damageMapping(homog)%p(ip,el) + + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + sum(plasticState(phase)%slipRate(:,constituent))/ & + ((damage(homog)%p(damageOffset))**source_damage_isoDuctile_N(instance))/ & + source_damage_isoDuctile_critPlasticStrain(instance) + +end subroutine source_damage_isoDuctile_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + integer(pInt) :: & + phase, constituent, sourceOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + sourceOffset = source_damage_isoDuctile_offset(phase) + + localphiDot = 1.0_pReal - & + sourceState(phase)%p(sourceOffset)%state(1,constituent)* & + phi + + dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + +end subroutine source_damage_isoDuctile_getRateAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of local damage results +!-------------------------------------------------------------------------------------------------- +function source_damage_isoDuctile_postResults(ipc,ip,el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(source_damage_isoDuctile_sizePostResults( & + source_damage_isoDuctile_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_isoDuctile_postResults + + integer(pInt) :: & + instance, phase, constituent, sourceOffset, o, c + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_isoDuctile_instance(phase) + sourceOffset = source_damage_isoDuctile_offset(phase) + + c = 0_pInt + source_damage_isoDuctile_postResults = 0.0_pReal + + do o = 1_pInt,source_damage_isoDuctile_Noutput(instance) + select case(source_damage_isoDuctile_outputID(o,instance)) + case (damage_drivingforce_ID) + source_damage_isoDuctile_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) + c = c + 1 + + end select + enddo +end function source_damage_isoDuctile_postResults + +end module source_damage_isoDuctile diff --git a/code/source/source_thermal_dissipation.f90 b/code/source/source_thermal_dissipation.f90 new file mode 100644 index 000000000..83ad85167 --- /dev/null +++ b/code/source/source_thermal_dissipation.f90 @@ -0,0 +1,220 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for thermal source due to plastic dissipation +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_thermal_dissipation + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_thermal_dissipation_sizePostResults, & !< cumulative size of post results + source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? + source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_thermal_dissipation_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_thermal_dissipation_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_thermal_dissipation_Noutput !< number of outputs per instance of this source + + real(pReal), dimension(:), allocatable, private :: & + source_thermal_dissipation_coldworkCoeff + + public :: & + source_thermal_dissipation_init, & + source_thermal_dissipation_getRateAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_thermal_dissipation_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_thermal_dissipation_label, & + SOURCE_thermal_dissipation_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_thermal_dissipation_ID),pInt) + if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_thermal_dissipation_offset(material_Nphase), source=0_pInt) + allocate(source_thermal_dissipation_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_thermal_dissipation_instance(phase) = count(phase_source(:,1:phase) == SOURCE_thermal_dissipation_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == SOURCE_thermal_dissipation_ID) & + source_thermal_dissipation_offset(phase) = source + enddo + enddo + + allocate(source_thermal_dissipation_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_thermal_dissipation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_thermal_dissipation_output (maxval(phase_Noutput),maxNinstance)) + source_thermal_dissipation_output = '' + allocate(source_thermal_dissipation_Noutput(maxNinstance), source=0_pInt) + allocate(source_thermal_dissipation_coldworkCoeff(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_thermal_dissipation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = source_thermal_dissipation_instance(phase) ! which instance of my source is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('dissipation_coldworkcoeff') + source_thermal_dissipation_coldworkCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_thermal_dissipation_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_thermal_dissipation_instance(phase) + sourceOffset = source_thermal_dissipation_offset(phase) + + sizeDotState = 0_pInt + sizeDeltaState = 0_pInt + sizeState = 0_pInt + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_thermal_dissipation_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_thermal_dissipation_init + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local vacancy generation rate +!-------------------------------------------------------------------------------------------------- +subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar_v, Lp, ipc, ip, el) + use math, only: & + math_Mandel6to33 + use material, only: & + phaseAt, phasememberAt + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(6) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) + real(pReal), intent(in), dimension(3,3) :: & + Lp + real(pReal), intent(out) :: & + TDot, & + dTDOT_dT + integer(pInt) :: & + instance, phase, constituent + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_thermal_dissipation_instance(phase) + + TDot = source_thermal_dissipation_coldworkCoeff(instance)* & + sum(abs(math_Mandel6to33(Tstar_v)*Lp)) + dTDOT_dT = 0.0_pReal + +end subroutine source_thermal_dissipation_getRateAndItsTangent + +end module source_thermal_dissipation diff --git a/code/source/source_thermal_externalheat.f90 b/code/source/source_thermal_externalheat.f90 new file mode 100644 index 000000000..257012c06 --- /dev/null +++ b/code/source/source_thermal_externalheat.f90 @@ -0,0 +1,277 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for thermal source due to plastic dissipation +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_thermal_externalheat + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_thermal_externalheat_sizePostResults, & !< cumulative size of post results + source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism? + source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_thermal_externalheat_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_thermal_externalheat_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_thermal_externalheat_Noutput !< number of outputs per instance of this source + + integer(pInt), dimension(:), allocatable, private :: & + source_thermal_externalheat_nIntervals + + real(pReal), dimension(:,:), allocatable, private :: & + source_thermal_externalheat_time, & + source_thermal_externalheat_rate + + public :: & + source_thermal_externalheat_init, & + source_thermal_externalheat_dotState, & + source_thermal_externalheat_getRateAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_thermal_externalheat_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_thermal_externalheat_label, & + SOURCE_thermal_externalheat_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase,interval + character(len=65536) :: & + tag = '', & + line = '' + real(pReal), allocatable, dimension(:,:) :: temp_time, temp_rate + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_thermal_externalheat_ID),pInt) + if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_thermal_externalheat_offset(material_Nphase), source=0_pInt) + allocate(source_thermal_externalheat_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_thermal_externalheat_instance(phase) = count(phase_source(:,1:phase) == SOURCE_thermal_externalheat_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == SOURCE_thermal_externalheat_ID) & + source_thermal_externalheat_offset(phase) = source + enddo + enddo + + allocate(source_thermal_externalheat_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_thermal_externalheat_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_thermal_externalheat_output (maxval(phase_Noutput),maxNinstance)) + source_thermal_externalheat_output = '' + allocate(source_thermal_externalheat_Noutput(maxNinstance), source=0_pInt) + allocate(source_thermal_externalheat_nIntervals(maxNinstance), source=0_pInt) + + allocate(temp_time(maxNinstance,1000), source=0.0_pReal) + allocate(temp_rate(maxNinstance,1000), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_thermal_externalheat_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = source_thermal_externalheat_instance(phase) ! which instance of my source is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('externalheat_time') + if (chunkPos(1) <= 2_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//SOURCE_thermal_externalheat_label//')') + source_thermal_externalheat_nIntervals(instance) = chunkPos(1) - 2_pInt + do interval = 1, source_thermal_externalheat_nIntervals(instance) + 1_pInt + temp_time(instance, interval) = IO_floatValue(line,chunkPos,1_pInt + interval) + enddo + + case ('externalheat_rate') + do interval = 1, source_thermal_externalheat_nIntervals(instance) + 1_pInt + temp_rate(instance, interval) = IO_floatValue(line,chunkPos,1_pInt + interval) + enddo + + end select + endif; endif + enddo parsingFile + + allocate(source_thermal_externalheat_time(maxNinstance,maxval(source_thermal_externalheat_nIntervals)+1_pInt), source=0.0_pReal) + allocate(source_thermal_externalheat_rate(maxNinstance,maxval(source_thermal_externalheat_nIntervals)+1_pInt), source=0.0_pReal) + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_thermal_externalheat_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_thermal_externalheat_instance(phase) + sourceOffset = source_thermal_externalheat_offset(phase) + source_thermal_externalheat_time(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) = & + temp_time(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) + source_thermal_externalheat_rate(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) = & + temp_rate(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) + + sizeDotState = 1_pInt + sizeDeltaState = 0_pInt + sizeState = 1_pInt + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_thermal_externalheat_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.00001_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_thermal_externalheat_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine source_thermal_externalheat_dotState(ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + integer(pInt) :: & + phase, & + constituent, & + sourceOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + sourceOffset = source_thermal_externalheat_offset(phase) + + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 1.0_pReal + +end subroutine source_thermal_externalheat_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local vacancy generation rate +!-------------------------------------------------------------------------------------------------- +subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out) :: & + TDot, & + dTDot_dT + integer(pInt) :: & + instance, phase, constituent, sourceOffset, interval + real(pReal) :: & + norm_time + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_thermal_externalheat_instance(phase) + sourceOffset = source_thermal_externalheat_offset(phase) + + do interval = 1, source_thermal_externalheat_nIntervals(instance) + norm_time = (sourceState(phase)%p(sourceOffset)%state(1,constituent) - & + source_thermal_externalheat_time(instance,interval)) / & + (source_thermal_externalheat_time(instance,interval+1) - & + source_thermal_externalheat_time(instance,interval)) + if (norm_time >= 0.0_pReal .and. norm_time < 1.0_pReal) & + TDot = source_thermal_externalheat_rate(instance,interval ) * (1.0_pReal - norm_time) + & + source_thermal_externalheat_rate(instance,interval+1) * norm_time + enddo + dTDot_dT = 0.0 + +end subroutine source_thermal_externalheat_getRateAndItsTangent + +end module source_thermal_externalheat diff --git a/code/source/source_vacancy_irradiation.f90 b/code/source/source_vacancy_irradiation.f90 new file mode 100644 index 000000000..c4bcfba04 --- /dev/null +++ b/code/source/source_vacancy_irradiation.f90 @@ -0,0 +1,253 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for vacancy generation due to irradiation +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_vacancy_irradiation + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_vacancy_irradiation_sizePostResults, & !< cumulative size of post results + source_vacancy_irradiation_offset, & !< which source is my current damage mechanism? + source_vacancy_irradiation_instance !< instance of damage source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_vacancy_irradiation_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_vacancy_irradiation_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_vacancy_irradiation_Noutput !< number of outputs per instance of this damage + + real(pReal), dimension(:), allocatable, private :: & + source_vacancy_irradiation_cascadeProb, & + source_vacancy_irradiation_cascadeVolume + + public :: & + source_vacancy_irradiation_init, & + source_vacancy_irradiation_deltaState, & + source_vacancy_irradiation_getRateAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_irradiation_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_vacancy_irradiation_label, & + SOURCE_vacancy_irradiation_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_irradiation_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_vacancy_irradiation_ID),pInt) + if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_vacancy_irradiation_offset(material_Nphase), source=0_pInt) + allocate(source_vacancy_irradiation_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_vacancy_irradiation_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_irradiation_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_vacancy_irradiation_ID) & + source_vacancy_irradiation_offset(phase) = source + enddo + enddo + + allocate(source_vacancy_irradiation_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_vacancy_irradiation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_vacancy_irradiation_output(maxval(phase_Noutput),maxNinstance)) + source_vacancy_irradiation_output = '' + allocate(source_vacancy_irradiation_Noutput(maxNinstance), source=0_pInt) + allocate(source_vacancy_irradiation_cascadeProb(maxNinstance), source=0.0_pReal) + allocate(source_vacancy_irradiation_cascadeVolume(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = source_vacancy_irradiation_instance(phase) ! which instance of my vacancy is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('irradiation_cascadeprobability') + source_vacancy_irradiation_cascadeProb(instance) = IO_floatValue(line,chunkPos,2_pInt) + + case ('irradiation_cascadevolume') + source_vacancy_irradiation_cascadeVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_vacancy_irradiation_instance(phase) + sourceOffset = source_vacancy_irradiation_offset(phase) + + sizeDotState = 2_pInt + sizeDeltaState = 2_pInt + sizeState = 2_pInt + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_irradiation_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.1_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_vacancy_irradiation_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_irradiation_deltaState(ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + integer(pInt) :: & + phase, constituent, sourceOffset + real(pReal) :: & + randNo + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + sourceOffset = source_vacancy_irradiation_offset(phase) + + call random_number(randNo) + sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + randNo - sourceState(phase)%p(sourceOffset)%state(1,constituent) + call random_number(randNo) + sourceState(phase)%p(sourceOffset)%deltaState(2,constituent) = & + randNo - sourceState(phase)%p(sourceOffset)%state(2,constituent) + +end subroutine source_vacancy_irradiation_deltaState + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local vacancy generation rate +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_irradiation_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out) :: & + CvDot, dCvDot_dCv + integer(pInt) :: & + instance, phase, constituent, sourceOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_vacancy_irradiation_instance(phase) + sourceOffset = source_vacancy_irradiation_offset(phase) + + CvDot = 0.0_pReal + dCvDot_dCv = 0.0_pReal + if (sourceState(phase)%p(sourceOffset)%state0(1,constituent) < source_vacancy_irradiation_cascadeProb(instance)) & + CvDot = sourceState(phase)%p(sourceOffset)%state0(2,constituent)*source_vacancy_irradiation_cascadeVolume(instance) + +end subroutine source_vacancy_irradiation_getRateAndItsTangent + +end module source_vacancy_irradiation diff --git a/code/source/source_vacancy_phenoplasticity.f90 b/code/source/source_vacancy_phenoplasticity.f90 new file mode 100644 index 000000000..f9e766b2c --- /dev/null +++ b/code/source/source_vacancy_phenoplasticity.f90 @@ -0,0 +1,215 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for vacancy generation due to plasticity +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_vacancy_phenoplasticity + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_vacancy_phenoplasticity_sizePostResults, & !< cumulative size of post results + source_vacancy_phenoplasticity_offset, & !< which source is my current damage mechanism? + source_vacancy_phenoplasticity_instance !< instance of damage source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_vacancy_phenoplasticity_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_vacancy_phenoplasticity_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_vacancy_phenoplasticity_Noutput !< number of outputs per instance of this damage + + real(pReal), dimension(:), allocatable, private :: & + source_vacancy_phenoplasticity_rateCoeff + + public :: & + source_vacancy_phenoplasticity_init, & + source_vacancy_phenoplasticity_getRateAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_phenoplasticity_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_vacancy_phenoplasticity_label, & + SOURCE_vacancy_phenoplasticity_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_phenoplasticity_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_vacancy_phenoplasticity_ID),pInt) + if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_vacancy_phenoplasticity_offset(material_Nphase), source=0_pInt) + allocate(source_vacancy_phenoplasticity_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_vacancy_phenoplasticity_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_phenoplasticity_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_vacancy_phenoplasticity_ID) & + source_vacancy_phenoplasticity_offset(phase) = source + enddo + enddo + + allocate(source_vacancy_phenoplasticity_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_vacancy_phenoplasticity_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_vacancy_phenoplasticity_output(maxval(phase_Noutput),maxNinstance)) + source_vacancy_phenoplasticity_output = '' + allocate(source_vacancy_phenoplasticity_Noutput(maxNinstance), source=0_pInt) + allocate(source_vacancy_phenoplasticity_rateCoeff(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = source_vacancy_phenoplasticity_instance(phase) ! which instance of my vacancy is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('phenoplasticity_ratecoeff') + source_vacancy_phenoplasticity_rateCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_vacancy_phenoplasticity_instance(phase) + sourceOffset = source_vacancy_phenoplasticity_offset(phase) + + sizeDotState = 0_pInt + sizeDeltaState = 0_pInt + sizeState = 0_pInt + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_phenoplasticity_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_vacancy_phenoplasticity_init + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local vacancy generation rate +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_phenoplasticity_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + plasticState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out) :: & + CvDot, dCvDot_dCv + integer(pInt) :: & + instance, phase, constituent + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_vacancy_phenoplasticity_instance(phase) + + CvDot = & + source_vacancy_phenoplasticity_rateCoeff(instance)* & + sum(plasticState(phase)%slipRate(:,constituent)) + dCvDot_dCv = 0.0_pReal + +end subroutine source_vacancy_phenoplasticity_getRateAndItsTangent + +end module source_vacancy_phenoplasticity diff --git a/code/source/source_vacancy_thermalfluc.f90 b/code/source/source_vacancy_thermalfluc.f90 new file mode 100644 index 000000000..c86406430 --- /dev/null +++ b/code/source/source_vacancy_thermalfluc.f90 @@ -0,0 +1,255 @@ +!-------------------------------------------------------------------------------------------------- +! $Id$ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for vacancy generation due to thermal fluctuations +!> @details to be done +!-------------------------------------------------------------------------------------------------- +module source_vacancy_thermalfluc + use prec, only: & + pReal, & + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_vacancy_thermalfluc_sizePostResults, & !< cumulative size of post results + source_vacancy_thermalfluc_offset, & !< which source is my current damage mechanism? + source_vacancy_thermalfluc_instance !< instance of damage source mechanism + + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_vacancy_thermalfluc_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_vacancy_thermalfluc_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + source_vacancy_thermalfluc_Noutput !< number of outputs per instance of this damage + + real(pReal), dimension(:), allocatable, private :: & + source_vacancy_thermalfluc_amplitude, & + source_vacancy_thermalfluc_normVacancyEnergy + + public :: & + source_vacancy_thermalfluc_init, & + source_vacancy_thermalfluc_deltaState, & + source_vacancy_thermalfluc_getRateAndItsTangent + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_thermalfluc_init(fileUnit) + 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 IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use lattice, only: & + lattice_vacancyFormationEnergy + use material, only: & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_vacancy_thermalfluc_label, & + SOURCE_vacancy_thermalfluc_ID, & + material_Nphase, & + material_phase, & + sourceState, & + MATERIAL_partPhase + use numerics,only: & + analyticJaco, & + worldrank, & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset + integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: NofMyPhase + character(len=65536) :: & + tag = '', & + line = '' + + mainProcess: if (worldrank == 0) then + write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_thermalfluc_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + endif mainProcess + + maxNinstance = int(count(phase_source == SOURCE_vacancy_thermalfluc_ID),pInt) + if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_vacancy_thermalfluc_offset(material_Nphase), source=0_pInt) + allocate(source_vacancy_thermalfluc_instance(material_Nphase), source=0_pInt) + do phase = 1, material_Nphase + source_vacancy_thermalfluc_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_thermalfluc_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_vacancy_thermalfluc_ID) & + source_vacancy_thermalfluc_offset(phase) = source + enddo + enddo + + allocate(source_vacancy_thermalfluc_sizePostResults(maxNinstance), source=0_pInt) + allocate(source_vacancy_thermalfluc_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_vacancy_thermalfluc_output(maxval(phase_Noutput),maxNinstance)) + source_vacancy_thermalfluc_output = '' + allocate(source_vacancy_thermalfluc_Noutput(maxNinstance), source=0_pInt) + allocate(source_vacancy_thermalfluc_amplitude(maxNinstance), source=0.0_pReal) + allocate(source_vacancy_thermalfluc_normVacancyEnergy(maxNinstance), source=0.0_pReal) + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + cycle ! skip to next line + endif + + if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + + instance = source_vacancy_thermalfluc_instance(phase) ! which instance of my vacancy is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('thermalfluctuation_amplitude') + source_vacancy_thermalfluc_amplitude(instance) = IO_floatValue(line,chunkPos,2_pInt) + + end select + endif; endif + enddo parsingFile + + initializeInstances: do phase = 1_pInt, material_Nphase + if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then + NofMyPhase=count(material_phase==phase) + instance = source_vacancy_thermalfluc_instance(phase) + source_vacancy_thermalfluc_normVacancyEnergy(instance) = & + lattice_vacancyFormationEnergy(phase)/1.3806488e-23_pReal + sourceOffset = source_vacancy_thermalfluc_offset(phase) + + sizeDotState = 1_pInt + sizeDeltaState = 1_pInt + sizeState = 1_pInt + sourceState(phase)%p(sourceOffset)%sizeState = sizeState + sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState + sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_thermalfluc_sizePostResults(instance) + allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.1_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + if (.not. analyticJaco) then + allocate(sourceState(phase)%p(sourceOffset)%state_backup (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%dotState_backup (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 1_pInt)) then + allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + + endif + + enddo initializeInstances +end subroutine source_vacancy_thermalfluc_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_thermalfluc_deltaState(ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + integer(pInt) :: & + phase, constituent, sourceOffset + real(pReal) :: & + randNo + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + sourceOffset = source_vacancy_thermalfluc_offset(phase) + + call random_number(randNo) + sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + randNo - 0.5_pReal - sourceState(phase)%p(sourceOffset)%state(1,constituent) + +end subroutine source_vacancy_thermalfluc_deltaState + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local vacancy generation rate +!-------------------------------------------------------------------------------------------------- +subroutine source_vacancy_thermalfluc_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el) + use material, only: & + phaseAt, phasememberAt, & + material_homog, & + temperature, & + thermalMapping, & + sourceState + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out) :: & + CvDot, dCvDot_dCv + integer(pInt) :: & + instance, phase, constituent, sourceOffset + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_vacancy_thermalfluc_instance(phase) + sourceOffset = source_vacancy_thermalfluc_offset(phase) + + CvDot = source_vacancy_thermalfluc_amplitude(instance)* & + sourceState(phase)%p(sourceOffset)%state0(2,constituent)* & + exp(-source_vacancy_thermalfluc_normVacancyEnergy(instance)/ & + temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))) + dCvDot_dCv = 0.0_pReal + +end subroutine source_vacancy_thermalfluc_getRateAndItsTangent + +end module source_vacancy_thermalfluc diff --git a/lib/damask/core.so b/lib/damask/core.so deleted file mode 100755 index 7f744dafa..000000000 Binary files a/lib/damask/core.so and /dev/null differ diff --git a/lib/damask/corientation.so b/lib/damask/corientation.so deleted file mode 100755 index 76fcf94f9..000000000 Binary files a/lib/damask/corientation.so and /dev/null differ