diff --git a/CMakeLists.txt b/CMakeLists.txt index 4a2af196d..2b9eba77b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,5 +1,5 @@ -# Initial attempt of using CMake to build the spectral solver -# --> CMake should be able to take care of the dependence by itself. +# 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) @@ -52,5 +52,15 @@ else (Fortran_COMPILER_NAME MATCHES "gfortran.*") endif (Fortran_COMPILER_NAME MATCHES "gfortran.*") -# add code(source) directory -add_subdirectory(code) \ No newline at end of file +# ADD CODE(SOURCE) DIRECTORY +add_subdirectory(code) + + +# ADD TESTING CASES +add_test (SmokeTestRun + DAMASK_spectral.exe -g test/test1.geom -l test/test.load) + + +# Enable Dashboard scripting +# include (CTest) +# set (CTEST_PROJECT_NAME "DAMASK") diff --git a/code/CMakeLists.txt b/code/CMakeLists.txt index 742d7e146..9c9688490 100644 --- a/code/CMakeLists.txt +++ b/code/CMakeLists.txt @@ -25,6 +25,11 @@ foreach (p ${SRC}) add_library (${p} MODULE "${p}.f90") endforeach (p) +# set libraries/modules for linking +foreach (p ${SRC}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) + # compile each sub moudel add_subdirectory(damage) add_subdirectory(homogenization) @@ -37,5 +42,6 @@ add_subdirectory(spectral) add_subdirectory(thermal) add_subdirectory(vacancyflux) -# compile spectral solver +# compile spectral solver add_executable(DAMASKSpectral.exe DAMASK_spectral.f90) +target_link_libraries (DAMASKSpectral.exe ${AUX_LIB}) \ No newline at end of file diff --git a/code/damage/CMakeLists.txt b/code/damage/CMakeLists.txt index 483baba57..ef6c768bd 100644 --- a/code/damage/CMakeLists.txt +++ b/code/damage/CMakeLists.txt @@ -8,3 +8,8 @@ set (DAMAGE "damage_none" foreach (p ${DAMAGE}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries for linking +foreach (p ${DAMAGE}) + set (AUX_LIB ${AUX_LIB} ${P}) +endforeach (p) \ No newline at end of file diff --git a/code/damage_local.f90 b/code/damage_local.f90 deleted file mode 100644 index 196382c13..000000000 --- a/code/damage_local.f90 +++ /dev/null @@ -1,327 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_none.f90 b/code/damage_none.f90 deleted file mode 100644 index 956ba5cc8..000000000 --- a/code/damage_none.f90 +++ /dev/null @@ -1,60 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_nonlocal.f90 b/code/damage_nonlocal.f90 deleted file mode 100644 index 311570781..000000000 --- a/code/damage_nonlocal.f90 +++ /dev/null @@ -1,380 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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.f90 b/code/homogenization.f90 deleted file mode 100644 index 00186ff06..000000000 --- a/code/homogenization.f90 +++ /dev/null @@ -1,1396 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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/CMakeLists.txt b/code/homogenization/CMakeLists.txt index 84555e333..584f1f89a 100644 --- a/code/homogenization/CMakeLists.txt +++ b/code/homogenization/CMakeLists.txt @@ -9,3 +9,8 @@ set (HOMOGENIZATION "homogenization" foreach (p ${HOMOGENIZATION}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${HOMOGENIZATION}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/homogenization_RGC.f90 b/code/homogenization_RGC.f90 deleted file mode 100644 index 323ca2934..000000000 --- a/code/homogenization_RGC.f90 +++ /dev/null @@ -1,1558 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_isostrain.f90 b/code/homogenization_isostrain.f90 deleted file mode 100644 index 083107d9f..000000000 --- a/code/homogenization_isostrain.f90 +++ /dev/null @@ -1,317 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_none.f90 b/code/homogenization_none.f90 deleted file mode 100644 index 59e483c27..000000000 --- a/code/homogenization_none.f90 +++ /dev/null @@ -1,60 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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 index ef296400b..4f133e0f6 100644 --- a/code/hydrogenflux/CMakeLists.txt +++ b/code/hydrogenflux/CMakeLists.txt @@ -7,3 +7,8 @@ set (HYDROGENFLUX "hydrogenflux_isoconc" foreach (p ${HYDROGENFLUX}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${HYDROGENFLUX}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/hydrogenflux_cahnhilliard.f90 b/code/hydrogenflux_cahnhilliard.f90 deleted file mode 100644 index d8cb71edc..000000000 --- a/code/hydrogenflux_cahnhilliard.f90 +++ /dev/null @@ -1,513 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_isoconc.f90 b/code/hydrogenflux_isoconc.f90 deleted file mode 100644 index 74759d4c3..000000000 --- a/code/hydrogenflux_isoconc.f90 +++ /dev/null @@ -1,63 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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 index 17e1a7dd7..f387c5d31 100644 --- a/code/kinematics/CMakeLists.txt +++ b/code/kinematics/CMakeLists.txt @@ -10,3 +10,8 @@ set (KINEMATICS "kinematics_cleavage_opening" foreach (p ${KINEMATICS}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${KINEMATICS}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/kinematics_cleavage_opening.f90 b/code/kinematics_cleavage_opening.f90 deleted file mode 100644 index 945e2d08a..000000000 --- a/code/kinematics_cleavage_opening.f90 +++ /dev/null @@ -1,303 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_hydrogen_strain.f90 b/code/kinematics_hydrogen_strain.f90 deleted file mode 100644 index ceb3b1ef3..000000000 --- a/code/kinematics_hydrogen_strain.f90 +++ /dev/null @@ -1,264 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_slipplane_opening.f90 b/code/kinematics_slipplane_opening.f90 deleted file mode 100644 index 8b49e1cf3..000000000 --- a/code/kinematics_slipplane_opening.f90 +++ /dev/null @@ -1,323 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_thermal_expansion.f90 b/code/kinematics_thermal_expansion.f90 deleted file mode 100644 index b99c499f3..000000000 --- a/code/kinematics_thermal_expansion.f90 +++ /dev/null @@ -1,228 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_vacancy_strain.f90 b/code/kinematics_vacancy_strain.f90 deleted file mode 100644 index 899bccd9f..000000000 --- a/code/kinematics_vacancy_strain.f90 +++ /dev/null @@ -1,265 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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 index 6c65481c3..3b6593c07 100644 --- a/code/plastic/CMakeLists.txt +++ b/code/plastic/CMakeLists.txt @@ -9,8 +9,13 @@ set (PLASTIC "plastic_dislotwin" "plastic_none" "plastic_phenoplus" ) - + # compile module foreach (p ${PLASTIC}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${PLASTIC}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/plastic_disloUCLA.f90 b/code/plastic_disloUCLA.f90 deleted file mode 100644 index d95a5e6a4..000000000 --- a/code/plastic_disloUCLA.f90 +++ /dev/null @@ -1,2116 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_dislotwin.f90 b/code/plastic_dislotwin.f90 deleted file mode 100644 index 532312bfd..000000000 --- a/code/plastic_dislotwin.f90 +++ /dev/null @@ -1,2542 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_isotropic.f90 b/code/plastic_isotropic.f90 deleted file mode 100644 index 13481b9a7..000000000 --- a/code/plastic_isotropic.f90 +++ /dev/null @@ -1,678 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_j2.f90 b/code/plastic_j2.f90 deleted file mode 100644 index 89c022cc9..000000000 --- a/code/plastic_j2.f90 +++ /dev/null @@ -1,579 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_none.f90 b/code/plastic_none.f90 deleted file mode 100644 index f624a80a2..000000000 --- a/code/plastic_none.f90 +++ /dev/null @@ -1,109 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_nonlocal.f90 b/code/plastic_nonlocal.f90 deleted file mode 100644 index 1922c08e2..000000000 --- a/code/plastic_nonlocal.f90 +++ /dev/null @@ -1,4031 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_phenoplus.f90 b/code/plastic_phenoplus.f90 deleted file mode 100644 index 0a40edd84..000000000 --- a/code/plastic_phenoplus.f90 +++ /dev/null @@ -1,1419 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_phenopowerlaw.f90 b/code/plastic_phenopowerlaw.f90 deleted file mode 100644 index 1f8e16250..000000000 --- a/code/plastic_phenopowerlaw.f90 +++ /dev/null @@ -1,1226 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_titanmod.f90 b/code/plastic_titanmod.f90 deleted file mode 100644 index abc6d661b..000000000 --- a/code/plastic_titanmod.f90 +++ /dev/null @@ -1,1913 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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 index 0695a1bf5..3e62f4096 100644 --- a/code/porosity/CMakeLists.txt +++ b/code/porosity/CMakeLists.txt @@ -7,3 +7,8 @@ set (POROSITY "porosity_none" foreach (p ${POROSITY}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${POROSITY}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/porosity_none.f90 b/code/porosity_none.f90 deleted file mode 100644 index 69f10a5c6..000000000 --- a/code/porosity_none.f90 +++ /dev/null @@ -1,61 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_phasefield.f90 b/code/porosity_phasefield.f90 deleted file mode 100644 index dc8b82b76..000000000 --- a/code/porosity_phasefield.f90 +++ /dev/null @@ -1,450 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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 index fa54f332a..398bce557 100644 --- a/code/source/CMakeLists.txt +++ b/code/source/CMakeLists.txt @@ -1,4 +1,4 @@ -# group source +# group source set (SOURCE "source_thermal_dissipation" "source_thermal_externalheat" "source_damage_isoBrittle" @@ -14,3 +14,8 @@ set (SOURCE "source_thermal_dissipation" foreach (p ${SOURCE}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${SOURCE}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/source_damage_anisoBrittle.f90 b/code/source_damage_anisoBrittle.f90 deleted file mode 100644 index a751eefdc..000000000 --- a/code/source_damage_anisoBrittle.f90 +++ /dev/null @@ -1,425 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_damage_anisoDuctile.f90 b/code/source_damage_anisoDuctile.f90 deleted file mode 100644 index 028fd479a..000000000 --- a/code/source_damage_anisoDuctile.f90 +++ /dev/null @@ -1,415 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_damage_isoBrittle.f90 b/code/source_damage_isoBrittle.f90 deleted file mode 100644 index c063ae86f..000000000 --- a/code/source_damage_isoBrittle.f90 +++ /dev/null @@ -1,383 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_damage_isoDuctile.f90 b/code/source_damage_isoDuctile.f90 deleted file mode 100644 index b0290264c..000000000 --- a/code/source_damage_isoDuctile.f90 +++ /dev/null @@ -1,350 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_thermal_dissipation.f90 b/code/source_thermal_dissipation.f90 deleted file mode 100644 index 83ad85167..000000000 --- a/code/source_thermal_dissipation.f90 +++ /dev/null @@ -1,220 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_thermal_externalheat.f90 b/code/source_thermal_externalheat.f90 deleted file mode 100644 index 257012c06..000000000 --- a/code/source_thermal_externalheat.f90 +++ /dev/null @@ -1,277 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_vacancy_irradiation.f90 b/code/source_vacancy_irradiation.f90 deleted file mode 100644 index c4bcfba04..000000000 --- a/code/source_vacancy_irradiation.f90 +++ /dev/null @@ -1,253 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_vacancy_phenoplasticity.f90 b/code/source_vacancy_phenoplasticity.f90 deleted file mode 100644 index f9e766b2c..000000000 --- a/code/source_vacancy_phenoplasticity.f90 +++ /dev/null @@ -1,215 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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_vacancy_thermalfluc.f90 b/code/source_vacancy_thermalfluc.f90 deleted file mode 100644 index c86406430..000000000 --- a/code/source_vacancy_thermalfluc.f90 +++ /dev/null @@ -1,255 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $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/code/spectral/CMakeLists.txt b/code/spectral/CMakeLists.txt index a11ff1303..659709917 100644 --- a/code/spectral/CMakeLists.txt +++ b/code/spectral/CMakeLists.txt @@ -5,10 +5,15 @@ set (SPECTRAL "spectral_damage" "spectral_mech_Basic" "spectral_mech_Polarisation" "spectral_thermal" - "spectral_utilities" + "spectral_utilities" ) # compile spectral solver driver module foreach (p ${SPECTRAL}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${SPECTRAL}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/spectral_damage.f90 b/code/spectral_damage.f90 deleted file mode 100644 index 0b79d5e5d..000000000 --- a/code/spectral_damage.f90 +++ /dev/null @@ -1,414 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id: spectral_damage.f90 4082 2015-04-11 20:28:07Z MPIE\m.diehl $ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Shaokang Zhang, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Spectral solver for nonlocal damage -!-------------------------------------------------------------------------------------------------- -module spectral_damage - use prec, only: & - pInt, & - pReal - use math, only: & - math_I3 - use spectral_utilities, only: & - tSolutionState, & - tSolutionParams - use numerics, only: & - worldrank, & - worldsize - - implicit none - private -#include - - character (len=*), parameter, public :: & - spectral_damage_label = 'spectraldamage' - -!-------------------------------------------------------------------------------------------------- -! derived types - type(tSolutionParams), private :: params - -!-------------------------------------------------------------------------------------------------- -! PETSc data - SNES, private :: damage_snes - Vec, private :: solution - PetscInt, private :: xstart, xend, ystart, yend, zstart, zend - real(pReal), private, dimension(:,:,:), allocatable :: & - damage_current, & !< field of current damage - damage_lastInc, & !< field of previous damage - damage_stagInc !< field of staggered damage - -!-------------------------------------------------------------------------------------------------- -! reference diffusion tensor, mobility etc. - integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment - real(pReal), dimension(3,3), private :: D_ref - real(pReal), private :: mobility_ref - character(len=1024), private :: incInfo - - public :: & - spectral_damage_init, & - spectral_damage_solution, & - spectral_damage_forward, & - spectral_damage_destroy - external :: & - VecDestroy, & - DMDestroy, & - DMDACreate3D, & - DMCreateGlobalVector, & - DMDASNESSetFunctionLocal, & - PETScFinalize, & - SNESDestroy, & - SNESGetNumberFunctionEvals, & - SNESGetIterationNumber, & - SNESSolve, & - SNESSetDM, & - SNESGetConvergedReason, & - SNESSetConvergenceTest, & - SNESSetFromOptions, & - SNESCreate, & - MPI_Abort, & - MPI_Bcast, & - MPI_Allreduce - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields and fills them with data, potentially from restart info -!-------------------------------------------------------------------------------------------------- -subroutine spectral_damage_init() - 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_intOut, & - IO_read_realFile, & - IO_timeStamp - use spectral_utilities, only: & - wgt - use mesh, only: & - grid, & - grid3 - use damage_nonlocal, only: & - damage_nonlocal_getDiffusion33, & - damage_nonlocal_getMobility - - implicit none - DM :: damage_grid - Vec :: uBound, lBound - PetscErrorCode :: ierr - PetscObject :: dummy - integer(pInt), dimension(:), allocatable :: localK - integer(pInt) :: proc - integer(pInt) :: i, j, k, cell - character(len=100) :: snes_type - - mainProcess: if (worldrank == 0_pInt) then - write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - -!-------------------------------------------------------------------------------------------------- -! initialize solver specific parts of PETSc - call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - call DMDACreate3d(PETSC_COMM_WORLD, & - DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & !< cut off stencil at boundary - DMDA_STENCIL_BOX, & !< Moore (26) neighborhood around central point - grid(1),grid(2),grid(3), & !< global grid - 1, 1, worldsize, & - 1, 0, & !< #dof (damage phase field), ghost boundary width (domain overlap) - grid(1),grid(2),localK, & !< local grid - damage_grid,ierr) !< handle, error - CHKERRQ(ierr) - call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da - call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,dummy,ierr) !< residual vector of same shape as solution vector - CHKERRQ(ierr) - call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional cli arguments - call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr) - if (trim(snes_type) == 'vinewtonrsls' .or. & - trim(snes_type) == 'vinewtonssls') then - call DMGetGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr) - call DMGetGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr) - call VecSet(lBound,0.0,ierr); CHKERRQ(ierr) - call VecSet(uBound,1.0,ierr); CHKERRQ(ierr) - call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr) !< variable bounds for variational inequalities like contact mechanics, damage etc. - call DMRestoreGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr) - call DMRestoreGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr) - endif - -!-------------------------------------------------------------------------------------------------- -! init fields - call DMDAGetCorners(damage_grid,xstart,ystart,zstart,xend,yend,zend,ierr) - CHKERRQ(ierr) - xend = xstart + xend - 1 - yend = ystart + yend - 1 - zend = zstart + zend - 1 - call VecSet(solution,1.0,ierr); CHKERRQ(ierr) - allocate(damage_current(grid(1),grid(2),grid3), source=1.0_pReal) - allocate(damage_lastInc(grid(1),grid(2),grid3), source=1.0_pReal) - allocate(damage_stagInc(grid(1),grid(2),grid3), source=1.0_pReal) - -!-------------------------------------------------------------------------------------------------- -! damage reference diffusion update - cell = 0_pInt - D_ref = 0.0_pReal - mobility_ref = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - D_ref = D_ref + damage_nonlocal_getDiffusion33(1,cell) - mobility_ref = mobility_ref + damage_nonlocal_getMobility(1,cell) - enddo; enddo; enddo - D_ref = D_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - mobility_ref = mobility_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - -end subroutine spectral_damage_init - -!-------------------------------------------------------------------------------------------------- -!> @brief solution for the spectral damage scheme with internal iterations -!-------------------------------------------------------------------------------------------------- -type(tSolutionState) function spectral_damage_solution(guess,timeinc,timeinc_old,loadCaseTime) - use numerics, only: & - itmax, & - err_damage_tolAbs, & - err_damage_tolRel - use spectral_utilities, only: & - tBoundaryCondition, & - Utilities_maskedCompliance, & - Utilities_updateGamma - use mesh, only: & - grid, & - grid3 - use damage_nonlocal, only: & - damage_nonlocal_putNonLocalDamage - - implicit none - -!-------------------------------------------------------------------------------------------------- -! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old, & !< increment in time of last increment - loadCaseTime !< remaining time of current load case - logical, intent(in) :: guess - integer(pInt) :: i, j, k, cell - PetscInt ::position - PetscReal :: minDamage, maxDamage, stagNorm, solnNorm - -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason - - spectral_damage_solution%converged =.false. - -!-------------------------------------------------------------------------------------------------- -! set module wide availabe data - params%timeinc = timeinc - params%timeincOld = timeinc_old - - call SNESSolve(damage_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) - call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) - - if (reason < 1) then - spectral_damage_solution%converged = .false. - spectral_damage_solution%iterationsNeeded = itmax - else - spectral_damage_solution%converged = .true. - spectral_damage_solution%iterationsNeeded = totalIter - endif - stagNorm = maxval(abs(damage_current - damage_stagInc)) - solnNorm = maxval(abs(damage_current)) - call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - damage_stagInc = damage_current - spectral_damage_solution%stagConverged = stagNorm < err_damage_tolAbs & - .or. stagNorm < err_damage_tolRel*solnNorm - -!-------------------------------------------------------------------------------------------------- -! updating damage state - cell = 0_pInt !< material point = 0 - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt !< material point increase - call damage_nonlocal_putNonLocalDamage(damage_current(i,j,k),1,cell) - enddo; enddo; enddo - - call VecMin(solution,position,minDamage,ierr); CHKERRQ(ierr) - call VecMax(solution,position,maxDamage,ierr); CHKERRQ(ierr) - if (worldrank == 0) then - if (spectral_damage_solution%converged) & - write(6,'(/,a)') ' ... nonlocal damage converged .....................................' - write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',& - minDamage, maxDamage, stagNorm - write(6,'(/,a)') ' ===========================================================================' - flush(6) - endif - -end function spectral_damage_solution - - -!-------------------------------------------------------------------------------------------------- -!> @brief forms the spectral damage residual vector -!-------------------------------------------------------------------------------------------------- -subroutine spectral_damage_formResidual(in,x_scal,f_scal,dummy,ierr) - use numerics, only: & - residualStiffness - use mesh, only: & - grid, & - grid3 - use math, only: & - math_mul33x3 - use spectral_utilities, only: & - scalarField_real, & - vectorField_real, & - utilities_FFTvectorForward, & - utilities_FFTvectorBackward, & - utilities_FFTscalarForward, & - utilities_FFTscalarBackward, & - utilities_fourierGreenConvolution, & - utilities_fourierScalarGradient, & - utilities_fourierVectorDivergence - use damage_nonlocal, only: & - damage_nonlocal_getSourceAndItsTangent,& - damage_nonlocal_getDiffusion33, & - damage_nonlocal_getMobility - - implicit none - DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & - in - PetscScalar, dimension( & - XG_RANGE,YG_RANGE,ZG_RANGE) :: & - x_scal - PetscScalar, dimension( & - X_RANGE,Y_RANGE,Z_RANGE) :: & - f_scal - PetscObject :: dummy - PetscErrorCode :: ierr - integer(pInt) :: i, j, k, cell - real(pReal) :: phiDot, dPhiDot_dPhi, mobility - - damage_current = x_scal -!-------------------------------------------------------------------------------------------------- -! evaluate polarization field - scalarField_real = 0.0_pReal - scalarField_real(1:grid(1),1:grid(2),1:grid3) = damage_current - call utilities_FFTscalarForward() - call utilities_fourierScalarGradient() !< calculate gradient of damage field - call utilities_FFTvectorBackward() - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - vectorField_real(1:3,i,j,k) = math_mul33x3(damage_nonlocal_getDiffusion33(1,cell) - D_ref, & - vectorField_real(1:3,i,j,k)) - enddo; enddo; enddo - call utilities_FFTvectorForward() - call utilities_fourierVectorDivergence() !< calculate damage divergence in fourier field - call utilities_FFTscalarBackward() - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - call damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, damage_current(i,j,k), 1, cell) - mobility = damage_nonlocal_getMobility(1,cell) - scalarField_real(i,j,k) = params%timeinc*scalarField_real(i,j,k) + & - params%timeinc*phiDot + & - mobility*damage_lastInc(i,j,k) - & - mobility*damage_current(i,j,k) + & - mobility_ref*damage_current(i,j,k) - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! convolution of damage field with green operator - call utilities_FFTscalarForward() - call utilities_fourierGreenConvolution(D_ref, mobility_ref, params%timeinc) - call utilities_FFTscalarBackward() - where(scalarField_real(1:grid(1),1:grid(2),1:grid3) > damage_lastInc) & - scalarField_real(1:grid(1),1:grid(2),1:grid3) = damage_lastInc - where(scalarField_real(1:grid(1),1:grid(2),1:grid3) < residualStiffness) & - scalarField_real(1:grid(1),1:grid(2),1:grid3) = residualStiffness - -!-------------------------------------------------------------------------------------------------- -! constructing residual - f_scal = scalarField_real(1:grid(1),1:grid(2),1:grid3) - damage_current - -end subroutine spectral_damage_formResidual - -!-------------------------------------------------------------------------------------------------- -!> @brief spectral damage forwarding routine -!-------------------------------------------------------------------------------------------------- -subroutine spectral_damage_forward(guess,timeinc,timeinc_old,loadCaseTime) - use mesh, only: & - grid, & - grid3 - use spectral_utilities, only: & - cutBack, & - wgt - use damage_nonlocal, only: & - damage_nonlocal_putNonLocalDamage, & - damage_nonlocal_getDiffusion33, & - damage_nonlocal_getMobility - - implicit none - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - logical, intent(in) :: guess - PetscErrorCode :: ierr - integer(pInt) :: i, j, k, cell - DM :: dm_local - PetscScalar, dimension(:,:,:), pointer :: x_scal - - if (cutBack) then - damage_current = damage_lastInc - damage_stagInc = damage_lastInc -!-------------------------------------------------------------------------------------------------- -! reverting damage field state - cell = 0_pInt - call SNESGetDM(damage_snes,dm_local,ierr); CHKERRQ(ierr) - call DMDAVecGetArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with - x_scal(xstart:xend,ystart:yend,zstart:zend) = damage_current - call DMDAVecRestoreArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr) - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - call damage_nonlocal_putNonLocalDamage(damage_current(i,j,k),1,cell) - enddo; enddo; enddo - else -!-------------------------------------------------------------------------------------------------- -! update rate and forward last inc - damage_lastInc = damage_current - cell = 0_pInt - D_ref = 0.0_pReal - mobility_ref = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - D_ref = D_ref + damage_nonlocal_getDiffusion33(1,cell) - mobility_ref = mobility_ref + damage_nonlocal_getMobility(1,cell) - enddo; enddo; enddo - D_ref = D_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - mobility_ref = mobility_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - endif - - end subroutine spectral_damage_forward - -!-------------------------------------------------------------------------------------------------- -!> @brief destroy routine -!-------------------------------------------------------------------------------------------------- -subroutine spectral_damage_destroy() - - implicit none - PetscErrorCode :: ierr - - call VecDestroy(solution,ierr); CHKERRQ(ierr) - call SNESDestroy(damage_snes,ierr); CHKERRQ(ierr) - -end subroutine spectral_damage_destroy - -end module spectral_damage diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 deleted file mode 100644 index b24c5f747..000000000 --- a/code/spectral_interface.f90 +++ /dev/null @@ -1,568 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Interfacing between the spectral solver and the material subroutines provided -!! by DAMASK -!> @details Interfacing between the spectral solver and the material subroutines provided -!> by DAMASK. Interpretating the command line arguments or, in case of called from f2py, -!> the arguments parsed to the init routine to get load case, geometry file, working -!> directory, etc. -!-------------------------------------------------------------------------------------------------- -module DAMASK_interface - use prec, only: & - pInt - - implicit none - private -#ifdef PETSc -#include -#endif - logical, public, protected :: appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding) - integer(pInt), public, protected :: spectralRestartInc = 1_pInt !< Increment at which calculation starts - character(len=1024), public, protected :: & - geometryFile = '', & !< parameter given for geometry file - loadCaseFile = '' !< parameter given for load case file - character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons - - public :: & - getSolverWorkingDirectoryName, & - getSolverJobName, & - DAMASK_interface_init - private :: & - storeWorkingDirectory, & - getGeometryFile, & - getLoadCaseFile, & - rectifyPath, & - makeRelativePath, & - getPathSep, & - IIO_stringValue, & - IIO_intValue, & - IIO_lc, & - IIO_stringPos - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief initializes the solver by interpreting the command line arguments. Also writes -!! information on computation to screen -!-------------------------------------------------------------------------------------------------- -subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) - - implicit none - character(len=1024), optional, intent(in) :: & - loadCaseParameterIn, & !< if using the f2py variant, the -l argument of DAMASK_spectral.exe - geometryParameterIn !< if using the f2py variant, the -g argument of DAMASK_spectral.exe - character(len=1024) :: & - commandLine, & !< command line call as string - loadCaseArg ='', & !< -l argument given to DAMASK_spectral.exe - geometryArg ='', & !< -g argument given to DAMASK_spectral.exe - workingDirArg ='', & !< -w argument given to DAMASK_spectral.exe - hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME) - userName, & !< name of user calling DAMASK_spectral.exe - tag - integer :: & - i, & - worldrank = 0 - integer, allocatable, dimension(:) :: & - chunkPos - integer, dimension(8) :: & - dateAndTime ! type default integer -#ifdef PETSc - PetscErrorCode :: ierr -#endif - external :: & - quit,& - MPI_Comm_rank,& - PETScInitialize, & - MPI_abort - -!-------------------------------------------------------------------------------------------------- -! PETSc Init -#ifdef PETSc - call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code - CHKERRQ(ierr) ! this is a macro definition, it is case sensitive - - open(6, encoding='UTF-8') ! modern fortran compilers (gfortran >4.4, ifort >11 support it) - call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) -#endif - mainProcess: if (worldrank == 0) then - call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' -#include "compilation_info.f90" - endif mainProcess - - if ( present(loadcaseParameterIn) .and. present(geometryParameterIn)) then ! both mandatory parameters given in function call - geometryArg = geometryParameterIn - loadcaseArg = loadcaseParameterIn - commandLine = 'n/a' - else if ( .not.( present(loadcaseParameterIn) .and. present(geometryParameterIn))) then ! none parameters given in function call, trying to get them from command line - call get_command(commandLine) - chunkPos = IIO_stringPos(commandLine) - do i = 1, chunkPos(1) - tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key - select case(tag) - case ('-h','--help') - mainProcess2: if (worldrank == 0) then - write(6,'(a)') ' #######################################################################' - write(6,'(a)') ' DAMASK_spectral:' - write(6,'(a)') ' The spectral method boundary value problem solver for' - write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit' - write(6,'(a,/)')' #######################################################################' - write(6,'(a,/)')' Valid command line switches:' - write(6,'(a)') ' --geom (-g, --geometry)' - write(6,'(a)') ' --load (-l, --loadcase)' - write(6,'(a)') ' --workingdir (-w, --wd, --workingdirectory, -d, --directory)' - write(6,'(a)') ' --restart (-r, --rs)' - write(6,'(a)') ' --regrid (--rg)' - write(6,'(a)') ' --help (-h)' - write(6,'(/,a)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Mandatory arguments:' - write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' - write(6,'(a)') ' Specifies the location of the geometry definition file,' - write(6,'(a)') ' if no extension is given, .geom will be appended.' - write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified' - write(6,'(a)') ' via --workingdir.' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "numerics.config" in that directory.' - write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' - write(6,'(a)') ' Specifies the location of the load case definition file,' - write(6,'(a)') ' if no extension is given, .load will be appended.' - write(6,'(/,a)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Optional arguments:' - write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' - write(6,'(a)') ' Specifies the working directory and overwrites the default' - write(6,'(a)') ' "PathToGeomFile".' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "numerics.config" in that directory.' - write(6,'(/,a)')' --restart XX' - write(6,'(a)') ' Reads in total increment No. XX-1 and continues to' - write(6,'(a)') ' calculate total increment No. XX.' - write(6,'(a)') ' Appends to existing results file ' - write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".' - write(6,'(a)') ' Works only if the restart information for total increment' - write(6,'(a)') ' No. XX-1 is available in the working directory.' - write(6,'(/,a)')' --regrid XX' - write(6,'(a)') ' Reads in total increment No. XX-1 and continues to' - write(6,'(a)') ' calculate total increment No. XX.' - write(6,'(a)') ' Attention: Overwrites existing results file ' - write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".' - write(6,'(a)') ' Works only if the restart information for total increment' - write(6,'(a)') ' No. XX-1 is available in the working directory.' - write(6,'(/,a)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Help:' - write(6,'(/,a)')' --help' - write(6,'(a,/)')' Prints this message and exits' - call quit(0_pInt) ! normal Termination - endif mainProcess2 - case ('-l', '--load', '--loadcase') - loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) - case ('-g', '--geom', '--geometry') - geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) - case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') - workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) - case ('-r', '--rs', '--restart') - spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - appendToOutFile = .true. - case ('--rg', '--regrid') - spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - appendToOutFile = .false. - end select - enddo - endif - - if (len(trim(loadcaseArg)) == 0 .or. len(trim(geometryArg)) == 0) then - write(6,'(a)') ' Please specify geometry AND load case (-h for help)' - call quit(1_pInt) - endif - - workingDirectory = storeWorkingDirectory(trim(workingDirArg),trim(geometryArg)) - geometryFile = getGeometryFile(geometryArg) - loadCaseFile = getLoadCaseFile(loadCaseArg) - - call get_environment_variable('HOSTNAME',hostName) - call get_environment_variable('USER',userName) - mainProcess3: if (worldrank == 0) then - write(6,'(a,a)') ' Host name: ', trim(hostName) - write(6,'(a,a)') ' User name: ', trim(userName) - write(6,'(a,a)') ' Path separator: ', getPathSep() - write(6,'(a,a)') ' Command line call: ', trim(commandLine) - if (len(trim(workingDirArg))>0) & - write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) - write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) - write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) - write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) - write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) - write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) - write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) - if (SpectralRestartInc > 1_pInt) & - write(6,'(a,i6.6)') ' Restart at increment: ', spectralRestartInc - write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile - endif mainProcess3 - -end subroutine DAMASK_interface_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief extract working directory from given argument or from location of geometry file, -!! possibly converting relative arguments to absolut path -!> @todo change working directory with call chdir(storeWorkingDirectory)? -!-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg) -#ifdef __INTEL_COMPILER - use IFPORT -#endif - - implicit none - character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=*), intent(in) :: geometryArg !< geometry argument - character(len=1024) :: cwd - character :: pathSep - logical :: dirExists - external :: quit - integer :: error - - pathSep = getPathSep() - if (len(workingDirectoryArg)>0) then ! got working directory as input - if (workingDirectoryArg(1:1) == pathSep) then ! absolute path given as command line argument - storeWorkingDirectory = workingDirectoryArg - else - error = getcwd(cwd) ! relative path given as command line argument - storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg - endif - if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it - /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep -#ifdef __INTEL_COMPILER - inquire(directory = trim(storeWorkingDirectory)//'.', exist=dirExists) -#else - inquire(file = trim(storeWorkingDirectory), exist=dirExists) -#endif - if(.not. dirExists) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' - call quit(1_pInt) - endif - else ! using path to geometry file as working dir - if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument - storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) - else - error = getcwd(cwd) ! relative path given as command line argument - storeWorkingDirectory = trim(cwd)//pathSep//& - geometryArg(1:scan(geometryArg,pathSep,back=.true.)) - endif - endif - storeWorkingDirectory = rectifyPath(storeWorkingDirectory) - -end function storeWorkingDirectory - - -!-------------------------------------------------------------------------------------------------- -!> @brief simply returns the private string workingDir -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getSolverWorkingDirectoryName() - - implicit none - getSolverWorkingDirectoryName = workingDirectory - -end function getSolverWorkingDirectoryName - - -!-------------------------------------------------------------------------------------------------- -!> @brief solver job name (no extension) as combination of geometry and load case name -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getSolverJobName() - - implicit none - integer :: posExt,posSep - character :: pathSep - character(len=1024) :: tempString - - pathSep = getPathSep() - - tempString = geometryFile - posExt = scan(tempString,'.',back=.true.) - posSep = scan(tempString,pathSep,back=.true.) - - getSolverJobName = tempString(posSep+1:posExt-1) - - tempString = loadCaseFile - posExt = scan(tempString,'.',back=.true.) - posSep = scan(tempString,pathSep,back=.true.) - - getSolverJobName = trim(getSolverJobName)//'_'//tempString(posSep+1:posExt-1) - -end function getSolverJobName - - -!-------------------------------------------------------------------------------------------------- -!> @brief basename of geometry file with extension from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getGeometryFile(geometryParameter) -#ifdef __INTEL_COMPILER - use IFPORT -#endif - - implicit none - character(len=1024), intent(in) :: & - geometryParameter - character(len=1024) :: & - cwd - integer :: posExt, posSep - character :: pathSep - integer :: error - - getGeometryFile = geometryParameter - pathSep = getPathSep() - posExt = scan(getGeometryFile,'.',back=.true.) - posSep = scan(getGeometryFile,pathSep,back=.true.) - - if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present - if (scan(getGeometryFile,pathSep) /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - getGeometryFile = rectifyPath(trim(cwd)//pathSep//getGeometryFile) - else - getGeometryFile = rectifyPath(getGeometryFile) - endif - - getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile) - -end function getGeometryFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief relative path of loadcase from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getLoadCaseFile(loadCaseParameter) -#ifdef __INTEL_COMPILER - use IFPORT -#endif - - implicit none - character(len=1024), intent(in) :: & - loadCaseParameter - character(len=1024) :: & - cwd - integer :: posExt, posSep, error - character :: pathSep - - getLoadCaseFile = loadcaseParameter - pathSep = getPathSep() - posExt = scan(getLoadCaseFile,'.',back=.true.) - posSep = scan(getLoadCaseFile,pathSep,back=.true.) - - if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present - if (scan(getLoadCaseFile,pathSep) /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - getLoadCaseFile = rectifyPath(trim(cwd)//pathSep//getLoadCaseFile) - else - getLoadCaseFile = rectifyPath(getLoadCaseFile) - endif - - getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile) - -end function getLoadCaseFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief remove ../ and /./ from path -!-------------------------------------------------------------------------------------------------- -function rectifyPath(path) - - implicit none - character(len=*) :: path - character(len=len_trim(path)) :: rectifyPath - character :: pathSep - integer :: i,j,k,l ! no pInt - - pathSep = getPathSep() - -!-------------------------------------------------------------------------------------------------- -! remove /./ from path - l = len_trim(path) - rectifyPath = path - do i = l,3,-1 - if (rectifyPath(i-2:i) == pathSep//'.'//pathSep) & - rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' - enddo - -!-------------------------------------------------------------------------------------------------- -! remove ../ and corresponding directory from rectifyPath - l = len_trim(rectifyPath) - i = index(rectifyPath(i:l),'..'//pathSep) - j = 0 - do while (i > j) - j = scan(rectifyPath(1:i-2),pathSep,back=.true.) - rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j) - if (rectifyPath(j+1:j+1) == pathSep) then !search for '//' that appear in case of XXX/../../XXX - k = len_trim(rectifyPath) - rectifyPath(j+1:k-1) = rectifyPath(j+2:k) - rectifyPath(k:k) = ' ' - endif - i = j+index(rectifyPath(j+1:l),'..'//pathSep) - enddo - if(len_trim(rectifyPath) == 0) rectifyPath = pathSep - -end function rectifyPath - - -!-------------------------------------------------------------------------------------------------- -!> @brief relative path from absolute a to absolute b -!-------------------------------------------------------------------------------------------------- -character(len=1024) function makeRelativePath(a,b) - - implicit none - character (len=*) :: a,b - character :: pathSep - integer :: i,posLastCommonSlash,remainingSlashes !no pInt - - pathSep = getPathSep() - posLastCommonSlash = 0 - remainingSlashes = 0 - - do i = 1, min(1024,len_trim(a),len_trim(b)) - if (a(i:i) /= b(i:i)) exit - if (a(i:i) == pathSep) posLastCommonSlash = i - enddo - do i = posLastCommonSlash+1,len_trim(a) - if (a(i:i) == pathSep) remainingSlashes = remainingSlashes + 1 - enddo - makeRelativePath = repeat('..'//pathSep,remainingSlashes)//b(posLastCommonSlash+1:len_trim(b)) - -end function makeRelativePath - - -!-------------------------------------------------------------------------------------------------- -!> @brief counting / and \ in $PATH System variable the character occuring more often is assumed -! to be the path separator -!-------------------------------------------------------------------------------------------------- -character function getPathSep() - - implicit none - character(len=2048) :: & - path - integer(pInt) :: & - backslash = 0_pInt, & - slash = 0_pInt - integer :: i - - call get_environment_variable('PATH',path) - do i=1, len(trim(path)) - if (path(i:i)=='/') slash = slash + 1_pInt - if (path(i:i)=='\') backslash = backslash + 1_pInt - enddo - - if (backslash>slash) then - getPathSep = '\' - else - getPathSep = '/' - endif - -end function getPathSep - - -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_stringValue for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_stringValue(string,chunkPos,myChunk) - - implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - - - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - IIO_stringValue = '' - else valuePresent - IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) - endif valuePresent - -end function IIO_stringValue - - -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_intValue for documentation -!-------------------------------------------------------------------------------------------------- -integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired sub string - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - - - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - IIO_intValue = 0_pInt - else valuePresent - read(UNIT=string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),ERR=100,FMT=*) IIO_intValue - endif valuePresent - return -100 IIO_intValue = huge(1_pInt) - -end function IIO_intValue - - -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_lc for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_lc(string) - - implicit none - character(len=*), intent(in) :: string !< string to convert - character(len=len(string)) :: IIO_lc - - character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - - integer :: i,n ! no pInt (len returns default integer) - - IIO_lc = string - do i=1,len(string) - n = index(UPPER,IIO_lc(i:i)) - if (n/=0) IIO_lc(i:i) = LOWER(n:n) - enddo - -end function IIO_lc - - -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_stringPos for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_stringPos(string) - - implicit none - integer(pInt), dimension(:), allocatable :: IIO_stringPos - character(len=*), intent(in) :: string !< string in which chunks are searched for - - character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces - integer :: left, right ! no pInt (verify and scan return default integer) - - allocate(IIO_stringPos(1), source=0_pInt) - right = 0 - - do while (verify(string(right+1:),SEP)>0) - left = right + verify(string(right+1:),SEP) - right = left + scan(string(left:),SEP) - 2 - if ( string(left:left) == '#' ) exit - IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)] - IIO_stringPos(1) = IIO_stringPos(1)+1_pInt - enddo - -end function IIO_stringPos - - -end module diff --git a/code/spectral_mech_AL.f90 b/code/spectral_mech_AL.f90 deleted file mode 100644 index a937dcc86..000000000 --- a/code/spectral_mech_AL.f90 +++ /dev/null @@ -1,715 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief AL scheme solver -!-------------------------------------------------------------------------------------------------- -module spectral_mech_AL - use prec, only: & - pInt, & - pReal - use math, only: & - math_I3 - use spectral_utilities, only: & - tSolutionState, & - tSolutionParams - - implicit none - private -#include - - character (len=*), parameter, public :: & - DAMASK_spectral_solverAL_label = 'al' - -!-------------------------------------------------------------------------------------------------- -! derived types - type(tSolutionParams), private :: params - real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! PETSc data - DM, private :: da - SNES, private :: snes - Vec, private :: solution_vec - -!-------------------------------------------------------------------------------------------------- -! common pointwise data - real(pReal), private, dimension(:,:,:,:,:), allocatable :: & - F_lastInc, & !< field of previous compatible deformation gradients - F_lambda_lastInc, & !< field of previous incompatible deformation gradient - Fdot, & !< field of assumed rate of compatible deformation gradient - F_lambdaDot !< field of assumed rate of incopatible deformation gradient - -!-------------------------------------------------------------------------------------------------- -! stress, stiffness and compliance average etc. - real(pReal), private, dimension(3,3) :: & - F_aimDot, & !< assumed rate of average deformation gradient - F_aim = math_I3, & !< current prescribed deformation gradient - F_aim_lastInc = math_I3, & !< previous average deformation gradient - F_av = 0.0_pReal, & !< average incompatible def grad field - P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress - P_avLastEval = 0.0_pReal !< average 1st Piola--Kirchhoff stress last call of CPFEM_general - character(len=1024), private :: incInfo !< time and increment information - real(pReal), private, dimension(3,3,3,3) :: & - C_volAvg = 0.0_pReal, & !< current volume average stiffness - C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness - C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness - S = 0.0_pReal, & !< current compliance (filled up with zeros) - C_scale = 0.0_pReal, & - S_scale = 0.0_pReal - - real(pReal), private :: & - err_BC, & !< deviation from stress BC - err_curl, & !< RMS of curl of F - err_div !< RMS of div of P - logical, private :: ForwardData - integer(pInt), private :: & - totalIter = 0_pInt !< total iteration in current increment - - public :: & - AL_init, & - AL_solution, & - AL_forward, & - AL_destroy - external :: & - VecDestroy, & - DMDestroy, & - DMDACreate3D, & - DMCreateGlobalVector, & - DMDASNESSetFunctionLocal, & - PETScFinalize, & - SNESDestroy, & - SNESGetNumberFunctionEvals, & - SNESGetIterationNumber, & - SNESSolve, & - SNESSetDM, & - SNESGetConvergedReason, & - SNESSetConvergenceTest, & - SNESSetFromOptions, & - SNESCreate, & - MPI_Abort, & - MPI_Bcast, & - MPI_Allreduce - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields and fills them with data, potentially from restart info -!> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc) -!-------------------------------------------------------------------------------------------------- -subroutine AL_init - 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_intOut, & - IO_read_realFile, & - IO_timeStamp - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRestart - use FEsolving, only: & - restartInc - use numerics, only: & - worldrank, & - worldsize - use DAMASK_interface, only: & - getSolverJobName - use spectral_utilities, only: & - Utilities_constitutiveResponse, & - Utilities_updateGamma, & - Utilities_updateIPcoords - use mesh, only: & - grid, & - grid3 - use math, only: & - math_invSym3333 - - implicit none - real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P - real(pReal), dimension(3,3) :: & - temp33_Real = 0.0_pReal - - PetscErrorCode :: ierr - PetscObject :: dummy - PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_lambda - integer(pInt), dimension(:), allocatable :: localK - integer(pInt) :: proc - character(len=1024) :: rankStr - - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif - -!-------------------------------------------------------------------------------------------------- -! allocate global fields - allocate (F_lastInc (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (Fdot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (F_lambda_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (F_lambdaDot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - -!-------------------------------------------------------------------------------------------------- -! PETSc Init - call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - call DMDACreate3d(PETSC_COMM_WORLD, & - DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary - DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - grid(1),grid(2),grid(3), & ! global grid - 1 , 1, worldsize, & - 18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap) - grid(1),grid(2),localK, & ! local grid - da,ierr) ! handle, error - CHKERRQ(ierr) - call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,dummy,ierr) - CHKERRQ(ierr) - call SNESSetConvergenceTest(snes,AL_converged,dummy,PETSC_NULL_FUNCTION,ierr) - CHKERRQ(ierr) - call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) - -!-------------------------------------------------------------------------------------------------- -! init fields - call DMDAVecGetArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! places pointer xx_psc on PETSc data - F => xx_psc(0:8,:,:,:) - F_lambda => xx_psc(9:17,:,:,:) - restart: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & - write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading values of increment ', restartInc - 1_pInt, ' from file' - flush(6) - write(rankStr,'(a1,i0)')'_',worldrank - call IO_read_realFile(777,'F'//trim(rankStr), trim(getSolverJobName()),size(F)) - read (777,rec=1) F - close (777) - call IO_read_realFile(777,'F_lastInc'//trim(rankStr), trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc - close (777) - call IO_read_realFile(777,'F_lambda'//trim(rankStr),trim(getSolverJobName()),size(F_lambda)) - read (777,rec=1) F_lambda - close (777) - call IO_read_realFile(777,'F_lambda_lastInc'//trim(rankStr),& - trim(getSolverJobName()),size(F_lambda_lastInc)) - read (777,rec=1) F_lambda_lastInc - close (777) - call IO_read_realFile(777,'F_aim', trim(getSolverJobName()),size(F_aim)) - read (777,rec=1) F_aim - close (777) - call IO_read_realFile(777,'F_aim_lastInc', trim(getSolverJobName()),size(F_aim_lastInc)) - read (777,rec=1) F_aim_lastInc - close (777) - call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) - read (777,rec=1) f_aimDot - close (777) - elseif (restartInc == 1_pInt) then restart - F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity - F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) - F_lambda = F - F_lambda_lastInc = F_lastInc - endif restart - - - call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) - nullify(F) - nullify(F_lambda) - call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc - - readRestart: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & - write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading more values of increment', restartInc - 1_pInt, 'from file' - flush(6) - call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg - close (777) - call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc - close (777) - call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg - close (777) - endif readRestart - - call Utilities_updateGamma(C_minMaxAvg,.True.) - C_scale = C_minMaxAvg - S_scale = math_invSym3333(C_minMaxAvg) - -end subroutine AL_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief solution for the AL scheme with internal iterations -!-------------------------------------------------------------------------------------------------- -type(tSolutionState) function & - AL_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,rotation_BC) - use IO, only: & - IO_error - use numerics, only: & - update_gamma - use math, only: & - math_invSym3333 - use spectral_utilities, only: & - tBoundaryCondition, & - Utilities_maskedCompliance, & - Utilities_updateGamma - use FEsolving, only: & - restartWrite, & - terminallyIll - - implicit none - -!-------------------------------------------------------------------------------------------------- -! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old, & !< increment in time of last increment - loadCaseTime !< remaining time of current load case - logical, intent(in) :: & - guess - type(tBoundaryCondition), intent(in) :: & - P_BC, & - F_BC - character(len=*), intent(in) :: & - incInfoIn - real(pReal), dimension(3,3), intent(in) :: rotation_BC - -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason - - incInfo = incInfoIn - -!-------------------------------------------------------------------------------------------------- -! update stiffness (and gamma operator) - S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C_volAvg) - if (update_gamma) then - call Utilities_updateGamma(C_minMaxAvg,restartWrite) - C_scale = C_minMaxAvg - S_scale = math_invSym3333(C_minMaxAvg) - endif - -!-------------------------------------------------------------------------------------------------- -! set module wide availabe data - mask_stress = P_BC%maskFloat - params%P_BC = P_BC%values - params%rotation_BC = rotation_BC - params%timeinc = timeinc - params%timeincOld = timeinc_old - -!-------------------------------------------------------------------------------------------------- -! solve BVP - call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) - CHKERRQ(ierr) - -!-------------------------------------------------------------------------------------------------- -! check convergence - call SNESGetConvergedReason(snes,reason,ierr) - CHKERRQ(ierr) - AL_solution%termIll = terminallyIll - terminallyIll = .false. - if (reason == -4) call IO_error(893_pInt) - if (reason < 1) AL_solution%converged = .false. - AL_solution%iterationsNeeded = totalIter - -end function AL_solution - - -!-------------------------------------------------------------------------------------------------- -!> @brief forms the AL residual vector -!-------------------------------------------------------------------------------------------------- -subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) - use numerics, only: & - itmax, & - itmin, & - polarAlpha, & - polarBeta, & - worldrank - use mesh, only: & - grid3, & - grid - use IO, only: & - IO_intOut - use math, only: & - math_rotate_backward33, & - math_transpose33, & - math_mul3333xx33, & - math_invSym3333, & - math_mul33x33 - use spectral_utilities, only: & - wgt, & - tensorField_real, & - utilities_FFTtensorForward, & - utilities_fourierGammaConvolution, & - utilities_FFTtensorBackward, & - Utilities_constitutiveResponse, & - Utilities_divergenceRMS, & - Utilities_curlRMS - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRotation - use homogenization, only: & - materialpoint_dPdF - use FEsolving, only: & - terminallyIll - - implicit none -!-------------------------------------------------------------------------------------------------- -! strange syntax in the next line because otherwise macros expand beyond 132 character limit - DMDALocalInfo, dimension(& - DMDA_LOCAL_INFO_SIZE) :: & - in - PetscScalar, target, dimension(3,3,2, & - XG_RANGE,YG_RANGE,ZG_RANGE) :: & - x_scal - PetscScalar, target, dimension(3,3,2, & - X_RANGE,Y_RANGE,Z_RANGE) :: & - f_scal - PetscScalar, pointer, dimension(:,:,:,:,:) :: & - F, & - F_lambda, & - residual_F, & - residual_F_lambda - PetscInt :: & - PETScIter, & - nfuncs - PetscObject :: dummy - PetscErrorCode :: ierr - integer(pInt) :: & - i, j, k, e - - F => x_scal(1:3,1:3,1,& - XG_RANGE,YG_RANGE,ZG_RANGE) - F_lambda => x_scal(1:3,1:3,2,& - XG_RANGE,YG_RANGE,ZG_RANGE) - residual_F => f_scal(1:3,1:3,1,& - X_RANGE,Y_RANGE,Z_RANGE) - residual_F_lambda => f_scal(1:3,1:3,2,& - X_RANGE,Y_RANGE,Z_RANGE) - - call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) - call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) - - F_av = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt - call MPI_Allreduce(MPI_IN_PLACE,F_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - - if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment - newIteration: if(totalIter <= PETScIter) then -!-------------------------------------------------------------------------------------------------- -! report begin of new iteration - totalIter = totalIter + 1_pInt - if (worldrank == 0_pInt) then - write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & - ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & - math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & - math_transpose33(F_aim) - flush(6) - endif - endif newIteration - -!-------------------------------------------------------------------------------------------------- -! - tensorField_real = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - tensorField_real(1:3,1:3,i,j,k) = & - polarBeta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -& - polarAlpha*math_mul33x33(F(1:3,1:3,i,j,k), & - math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3)) - - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! doing convolution in Fourier space - call utilities_FFTtensorForward() - call utilities_fourierGammaConvolution(math_rotate_backward33(polarBeta*F_aim,params%rotation_BC)) - call utilities_FFTtensorBackward() - -!-------------------------------------------------------------------------------------------------- -! constructing residual - residual_F_lambda = polarBeta*F - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) - -!-------------------------------------------------------------------------------------------------- -! evaluate constitutive response - P_avLastEval = P_av - call Utilities_constitutiveResponse(F_lastInc,F - residual_F_lambda/polarBeta,params%timeinc, & - residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) - call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) - ForwardData = .False. - -!-------------------------------------------------------------------------------------------------- -! calculate divergence - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = residual_F - call utilities_FFTtensorForward() - err_div = Utilities_divergenceRMS() - call utilities_FFTtensorBackward() - -!-------------------------------------------------------------------------------------------------- -! constructing residual - e = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - e = e + 1_pInt - residual_F(1:3,1:3,i,j,k) = math_mul3333xx33(math_invSym3333(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), & - residual_F(1:3,1:3,i,j,k) - & - math_mul33x33(F(1:3,1:3,i,j,k), & - math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3))) & - + residual_F_lambda(1:3,1:3,i,j,k) - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! calculating curl - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = F - call utilities_FFTtensorForward() - err_curl = Utilities_curlRMS() - call utilities_FFTtensorBackward() - -end subroutine AL_formResidual - - -!-------------------------------------------------------------------------------------------------- -!> @brief convergence check -!-------------------------------------------------------------------------------------------------- -subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) - use numerics, only: & - itmax, & - itmin, & - err_div_tolRel, & - err_div_tolAbs, & - err_curl_tolRel, & - err_curl_tolAbs, & - err_stress_tolAbs, & - err_stress_tolRel, & - worldrank - use math, only: & - math_mul3333xx33 - use FEsolving, only: & - terminallyIll - - implicit none - SNES :: snes_local - PetscInt :: PETScIter - PetscReal :: & - xnorm, & - snorm, & - fnorm - SNESConvergedReason :: reason - PetscObject :: dummy - PetscErrorCode ::ierr - real(pReal) :: & - curlTol, & - divTol, & - BC_tol - -!-------------------------------------------------------------------------------------------------- -! stress BC handling - F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc - err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + & - mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc - -!-------------------------------------------------------------------------------------------------- -! error calculation - curlTol = max(maxval(abs(F_aim-math_I3))*err_curl_tolRel,err_curl_tolAbs) - divTol = max(maxval(abs(P_av)) *err_div_tolRel,err_div_tolAbs) - BC_tol = max(maxval(abs(P_av)) *err_stress_tolrel,err_stress_tolabs) - - converged: if ((totalIter >= itmin .and. & - all([ err_div/divTol, & - err_curl/curlTol, & - err_BC/BC_tol ] < 1.0_pReal)) & - .or. terminallyIll) then - reason = 1 - elseif (totalIter >= itmax) then converged - reason = -1 - else converged - reason = 0 - endif converged - -!-------------------------------------------------------------------------------------------------- -! report - if (worldrank == 0_pInt) then - write(6,'(1/,a)') ' ... reporting .............................................................' - write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & - err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' - write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & - err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' - write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & - err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' - write(6,'(/,a)') ' ===========================================================================' - flush(6) - endif - -end subroutine AL_converged - -!-------------------------------------------------------------------------------------------------- -!> @brief forwarding routine -!-------------------------------------------------------------------------------------------------- -subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_BC) - use math, only: & - math_mul33x33, & - math_mul3333xx33, & - math_transpose33, & - math_rotate_backward33 - use numerics, only: & - worldrank - use mesh, only: & - grid3, & - grid - use spectral_utilities, only: & - Utilities_calculateRate, & - Utilities_forwardField, & - Utilities_updateIPcoords, & - tBoundaryCondition, & - cutBack - use IO, only: & - IO_write_JobRealFile - use FEsolving, only: & - restartWrite - - implicit none - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & - P_BC, & - F_BC - real(pReal), dimension(3,3), intent(in) :: rotation_BC - logical, intent(in) :: & - guess - PetscErrorCode :: ierr - PetscScalar, dimension(:,:,:,:), pointer :: xx_psc, F, F_lambda - integer(pInt) :: i, j, k - real(pReal), dimension(3,3) :: F_lambda33 - character(len=1024) :: rankStr - -!-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call DMDAVecGetArrayF90(da,solution_vec,xx_psc,ierr) - F => xx_psc(0:8,:,:,:) - F_lambda => xx_psc(9:17,:,:,:) - if (restartWrite) then - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' writing converged results for restart' - flush(6) - endif - write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F - close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc - close (777) - call IO_write_jobRealFile(777,'F_lambda'//trim(rankStr),size(F_lambda)) ! writing deformation gradient field to file - write (777,rec=1) F_lambda - close (777) - call IO_write_jobRealFile(777,'F_lambda_lastInc'//trim(rankStr),size(F_lambda_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lambda_lastInc - close (777) - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'F_aim',size(F_aim)) - write (777,rec=1) F_aim - close(777) - call IO_write_jobRealFile(777,'F_aim_lastInc',size(F_aim_lastInc)) - write (777,rec=1) F_aim_lastInc - close(777) - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot - close(777) - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg - close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc - close(777) - endif - endif - - call utilities_updateIPcoords(F) - - if (cutBack) then - F_aim = F_aim_lastInc - F_lambda = reshape(F_lambda_lastInc,[9,grid(1),grid(2),grid3]) - F = reshape(F_lastInc, [9,grid(1),grid(2),grid3]) - C_volAvg = C_volAvgLastInc - else - ForwardData = .True. - C_volAvgLastInc = C_volAvg -!-------------------------------------------------------------------------------------------------- -! calculate rate for aim - if (F_BC%myType=='l') then ! calculate f_aimDot from given L and current F - f_aimDot = F_BC%maskFloat * math_mul33x33(F_BC%values, F_aim) - elseif(F_BC%myType=='fdot') then ! f_aimDot is prescribed - f_aimDot = F_BC%maskFloat * F_BC%values - elseif(F_BC%myType=='f') then ! aim at end of load case is prescribed - f_aimDot = F_BC%maskFloat * (F_BC%values -F_aim)/loadCaseTime - endif - if (guess) f_aimDot = f_aimDot + P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old - F_aim_lastInc = F_aim - -!-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) - F_lambdaDot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lambda_lastInc,reshape(F_lambda,[3,3,grid(1),grid(2),grid3])) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) - F_lambda_lastInc = reshape(F_lambda,[3,3,grid(1),grid(2),grid3]) - endif - - F_aim = F_aim + f_aimDot * timeinc - -!-------------------------------------------------------------------------------------------------- -! update local deformation gradient - F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim - math_rotate_backward33(F_aim,rotation_BC)), & - [9,grid(1),grid(2),grid3]) - F_lambda = reshape(Utilities_forwardField(timeinc,F_lambda_lastInc,F_lambdadot), & - [9,grid(1),grid(2),grid3]) ! does not have any average value as boundary condition - if (.not. guess) then ! large strain forwarding - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - F_lambda33 = reshape(F_lambda(1:9,i,j,k),[3,3]) - F_lambda33 = math_mul3333xx33(S_scale,math_mul33x33(F_lambda33, & - math_mul3333xx33(C_scale,& - math_mul33x33(math_transpose33(F_lambda33),& - F_lambda33) -math_I3))*0.5_pReal)& - + math_I3 - F_lambda(1:9,i,j,k) = reshape(F_lambda33,[9]) - enddo; enddo; enddo - endif - call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) - -end subroutine AL_forward - -!-------------------------------------------------------------------------------------------------- -!> @brief destroy routine -!-------------------------------------------------------------------------------------------------- -subroutine AL_destroy() - use spectral_utilities, only: & - Utilities_destroy - - implicit none - PetscErrorCode :: ierr - - call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) - call SNESDestroy(snes,ierr); CHKERRQ(ierr) - call DMDestroy(da,ierr); CHKERRQ(ierr) - -end subroutine AL_destroy - -end module spectral_mech_AL diff --git a/code/spectral_mech_Basic.f90 b/code/spectral_mech_Basic.f90 deleted file mode 100644 index a8344fabe..000000000 --- a/code/spectral_mech_Basic.f90 +++ /dev/null @@ -1,569 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Basic scheme PETSc solver -!-------------------------------------------------------------------------------------------------- -module spectral_mech_basic - use prec, only: & - pInt, & - pReal - use math, only: & - math_I3 - use spectral_utilities, only: & - tSolutionState, & - tSolutionParams - - implicit none - private -#include - - character (len=*), parameter, public :: & - DAMASK_spectral_SolverBasicPETSC_label = 'basicpetsc' - -!-------------------------------------------------------------------------------------------------- -! derived types - type(tSolutionParams), private :: params - -!-------------------------------------------------------------------------------------------------- -! PETSc data - DM, private :: da - SNES, private :: snes - Vec, private :: solution_vec - -!-------------------------------------------------------------------------------------------------- -! common pointwise data - real(pReal), private, dimension(:,:,:,:,:), allocatable :: F_lastInc, Fdot - -!-------------------------------------------------------------------------------------------------- -! stress, stiffness and compliance average etc. - real(pReal), private, dimension(3,3) :: & - F_aim = math_I3, & - F_aim_lastIter = math_I3, & - F_aim_lastInc = math_I3, & - P_av = 0.0_pReal, & - F_aimDot=0.0_pReal - character(len=1024), private :: incInfo - real(pReal), private, dimension(3,3,3,3) :: & - C_volAvg = 0.0_pReal, & !< current volume average stiffness - C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness - C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness - S = 0.0_pReal !< current compliance (filled up with zeros) - real(pReal), private :: err_stress, err_div - logical, private :: ForwardData - integer(pInt), private :: & - totalIter = 0_pInt !< total iteration in current increment - real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal - - public :: & - basicPETSc_init, & - basicPETSc_solution, & - BasicPETSc_forward, & - basicPETSc_destroy - external :: & - VecDestroy, & - DMDestroy, & - DMDACreate3D, & - DMCreateGlobalVector, & - DMDASNESSetFunctionLocal, & - PETScFinalize, & - SNESDestroy, & - SNESGetNumberFunctionEvals, & - SNESGetIterationNumber, & - SNESSolve, & - SNESSetDM, & - SNESGetConvergedReason, & - SNESSetConvergenceTest, & - SNESSetFromOptions, & - SNESCreate, & - MPI_Abort, & - MPI_Bcast, & - MPI_Allreduce - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields and fills them with data, potentially from restart info -!-------------------------------------------------------------------------------------------------- -subroutine basicPETSc_init - 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_intOut, & - IO_read_realFile, & - IO_timeStamp - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRestart - use FEsolving, only: & - restartInc - use numerics, only: & - worldrank, & - worldsize - use DAMASK_interface, only: & - getSolverJobName - use spectral_utilities, only: & - Utilities_constitutiveResponse, & - Utilities_updateGamma, & - utilities_updateIPcoords, & - wgt - use mesh, only: & - grid, & - grid3 - use math, only: & - math_invSym3333 - - implicit none - real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P - PetscScalar, dimension(:,:,:,:), pointer :: F - PetscErrorCode :: ierr - PetscObject :: dummy - real(pReal), dimension(3,3) :: & - temp33_Real = 0.0_pReal - integer(pInt), dimension(:), allocatable :: localK - integer(pInt) :: proc - character(len=1024) :: rankStr - - mainProcess: if (worldrank == 0_pInt) then - write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - -!-------------------------------------------------------------------------------------------------- -! allocate global fields - allocate (F_lastInc (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (Fdot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - -!-------------------------------------------------------------------------------------------------- -! initialize solver specific parts of PETSc - call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - call DMDACreate3d(PETSC_COMM_WORLD, & - DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary - DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - grid(1),grid(2),grid(3), & ! global grid - 1, 1, worldsize, & - 9, 0, & ! #dof (F tensor), ghost boundary width (domain overlap) - grid (1),grid (2),localK, & ! local grid - da,ierr) ! handle, error - CHKERRQ(ierr) - call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,dummy,ierr) ! residual vector of same shape as solution vector - CHKERRQ(ierr) - call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da - call SNESSetConvergenceTest(snes,BasicPETSC_converged,dummy,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" - CHKERRQ(ierr) - call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments - -!-------------------------------------------------------------------------------------------------- -! init fields - call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with - - restart: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & - write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading values of increment ', restartInc - 1_pInt, ' from file' - flush(6) - write(rankStr,'(a1,i0)')'_',worldrank - call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) - read (777,rec=1) F - close (777) - call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc - close (777) - call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) - read (777,rec=1) f_aimDot - close (777) - F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F - F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc - elseif (restartInc == 1_pInt) then restart - F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity - F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) - endif restart - - call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal, & - P, & - C_volAvg,C_minMaxAvg, & ! global average of stiffness and (min+max)/2 - temp33_Real, & - .false., & - math_I3) - - call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc - - restartRead: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & - write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading more values of increment', restartInc - 1_pInt, 'from file' - flush(6) - call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg - close (777) - call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc - close (777) - call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg - close (777) - endif restartRead - - call Utilities_updateGamma(C_minmaxAvg,.True.) - -end subroutine basicPETSc_init - -!-------------------------------------------------------------------------------------------------- -!> @brief solution for the Basic PETSC scheme with internal iterations -!-------------------------------------------------------------------------------------------------- -type(tSolutionState) function & - basicPETSc_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,rotation_BC) - use IO, only: & - IO_error - use numerics, only: & - update_gamma - use spectral_utilities, only: & - tBoundaryCondition, & - Utilities_maskedCompliance, & - Utilities_updateGamma - use FEsolving, only: & - restartWrite, & - terminallyIll - - implicit none - -!-------------------------------------------------------------------------------------------------- -! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old, & !< increment in time of last increment - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & - P_BC, & - F_BC - character(len=*), intent(in) :: & - incInfoIn - real(pReal), dimension(3,3), intent(in) :: rotation_BC - logical, intent(in) :: & - guess - -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason - incInfo = incInfoIn - -!-------------------------------------------------------------------------------------------------- -! update stiffness (and gamma operator) - S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C_volAvg) - if (update_gamma) call Utilities_updateGamma(C_minmaxAvg,restartWrite) - - -!-------------------------------------------------------------------------------------------------- -! set module wide availabe data - mask_stress = P_BC%maskFloat - params%P_BC = P_BC%values - params%rotation_BC = rotation_BC - params%timeinc = timeinc - params%timeincOld = timeinc_old - -!-------------------------------------------------------------------------------------------------- -! solve BVP - call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) - CHKERRQ(ierr) - -!-------------------------------------------------------------------------------------------------- -! check convergence - call SNESGetConvergedReason(snes,reason,ierr) - CHKERRQ(ierr) - basicPETSc_solution%termIll = terminallyIll - terminallyIll = .false. - BasicPETSc_solution%converged =.true. - if (reason == -4) call IO_error(893_pInt) - if (reason < 1) basicPETSC_solution%converged = .false. - basicPETSC_solution%iterationsNeeded = totalIter - -end function BasicPETSc_solution - - -!-------------------------------------------------------------------------------------------------- -!> @brief forms the AL residual vector -!-------------------------------------------------------------------------------------------------- -subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) - use numerics, only: & - itmax, & - itmin - use numerics, only: & - worldrank - use mesh, only: & - grid, & - grid3 - use math, only: & - math_rotate_backward33, & - math_transpose33, & - math_mul3333xx33 - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRotation - use spectral_utilities, only: & - tensorField_real, & - utilities_FFTtensorForward, & - utilities_FFTtensorBackward, & - utilities_fourierGammaConvolution, & - Utilities_constitutiveResponse, & - Utilities_divergenceRMS - use IO, only: & - IO_intOut - use FEsolving, only: & - terminallyIll - - implicit none - DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & - in - PetscScalar, dimension(3,3, & - XG_RANGE,YG_RANGE,ZG_RANGE) :: & - x_scal - PetscScalar, dimension(3,3, & - X_RANGE,Y_RANGE,Z_RANGE) :: & - f_scal - PetscInt :: & - PETScIter, & - nfuncs - PetscObject :: dummy - PetscErrorCode :: ierr - - call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) - call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) - - if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment - newIteration: if (totalIter <= PETScIter) then -!-------------------------------------------------------------------------------------------------- -! report begin of new iteration - totalIter = totalIter + 1_pInt - if (worldrank == 0_pInt) then - write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & - ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & - math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & - math_transpose33(F_aim) - flush(6) - endif - endif newIteration - -!-------------------------------------------------------------------------------------------------- -! evaluate constitutive response - call Utilities_constitutiveResponse(F_lastInc,x_scal,params%timeinc, & - f_scal,C_volAvg,C_minmaxAvg,P_av,ForwardData,params%rotation_BC) - call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) - ForwardData = .false. - -!-------------------------------------------------------------------------------------------------- -! stress BC handling - F_aim_lastIter = F_aim - F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc - err_stress = maxval(abs(mask_stress * (P_av - params%P_BC))) ! mask = 0.0 for no bc - -!-------------------------------------------------------------------------------------------------- -! updated deformation gradient using fix point algorithm of basic scheme - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = f_scal - call utilities_FFTtensorForward() - err_div = Utilities_divergenceRMS() - call utilities_fourierGammaConvolution(math_rotate_backward33(F_aim_lastIter-F_aim,params%rotation_BC)) - call utilities_FFTtensorBackward() - -!-------------------------------------------------------------------------------------------------- -! constructing residual - f_scal = tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) - -end subroutine BasicPETSc_formResidual - - -!-------------------------------------------------------------------------------------------------- -!> @brief convergence check -!-------------------------------------------------------------------------------------------------- -subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) - use numerics, only: & - itmax, & - itmin, & - err_div_tolRel, & - err_div_tolAbs, & - err_stress_tolRel, & - err_stress_tolAbs, & - worldrank - use FEsolving, only: & - terminallyIll - - implicit none - SNES :: snes_local - PetscInt :: PETScIter - PetscReal :: & - xnorm, & - snorm, & - fnorm - SNESConvergedReason :: reason - PetscObject :: dummy - PetscErrorCode :: ierr - real(pReal) :: & - divTol, & - stressTol - - divTol = max(maxval(abs(P_av))*err_div_tolRel,err_div_tolAbs) - stressTol = max(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs) - - converged: if ((totalIter >= itmin .and. & - all([ err_div/divTol, & - err_stress/stressTol ] < 1.0_pReal)) & - .or. terminallyIll) then - reason = 1 - elseif (totalIter >= itmax) then converged - reason = -1 - else converged - reason = 0 - endif converged - -!-------------------------------------------------------------------------------------------------- -! report - if (worldrank == 0_pInt) then - write(6,'(1/,a)') ' ... reporting .............................................................' - write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & - err_div/divTol, ' (',err_div,' / m, tol =',divTol,')' - write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', & - err_stress/stressTol, ' (',err_stress, ' Pa, tol =',stressTol,')' - write(6,'(/,a)') ' ===========================================================================' - flush(6) - endif - -end subroutine BasicPETSc_converged - -!-------------------------------------------------------------------------------------------------- -!> @brief forwarding routine -!-------------------------------------------------------------------------------------------------- -subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_BC) - use math, only: & - math_mul33x33 ,& - math_rotate_backward33 - use mesh, only: & - grid, & - grid3 - use spectral_utilities, only: & - Utilities_calculateRate, & - Utilities_forwardField, & - utilities_updateIPcoords, & - tBoundaryCondition, & - cutBack - use IO, only: & - IO_write_JobRealFile - use FEsolving, only: & - restartWrite - use numerics, only: & - worldrank - - implicit none - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & - P_BC, & - F_BC - real(pReal), dimension(3,3), intent(in) :: rotation_BC - logical, intent(in) :: & - guess - PetscScalar, pointer :: F(:,:,:,:) - PetscErrorCode :: ierr - character(len=1024) :: rankStr - - call DMDAVecGetArrayF90(da,solution_vec,F,ierr) -!-------------------------------------------------------------------------------------------------- -! restart information for spectral solver - if (restartWrite) then - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' writing converged results for restart' - flush(6) - endif - write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F - close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc - close (777) - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot - close(777) - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg - close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc - close(777) - endif - endif - - call utilities_updateIPcoords(F) - - if (cutBack) then - F_aim = F_aim_lastInc - F = reshape(F_lastInc, [9,grid(1),grid(2),grid3]) - C_volAvg = C_volAvgLastInc - else - ForwardData = .True. - C_volAvgLastInc = C_volAvg -!-------------------------------------------------------------------------------------------------- -! calculate rate for aim - if (F_BC%myType=='l') then ! calculate f_aimDot from given L and current F - f_aimDot = F_BC%maskFloat * math_mul33x33(F_BC%values, F_aim) - elseif(F_BC%myType=='fdot') then ! f_aimDot is prescribed - f_aimDot = F_BC%maskFloat * F_BC%values - elseif(F_BC%myType=='f') then ! aim at end of load case is prescribed - f_aimDot = F_BC%maskFloat * (F_BC%values -F_aim)/loadCaseTime - endif - if (guess) f_aimDot = f_aimDot + P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old - F_aim_lastInc = F_aim - -!-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) - endif - F_aim = F_aim + f_aimDot * timeinc - -!-------------------------------------------------------------------------------------------------- -! update local deformation gradient - F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim - math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) - call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) - -end subroutine BasicPETSc_forward - -!-------------------------------------------------------------------------------------------------- -!> @brief destroy routine -!-------------------------------------------------------------------------------------------------- -subroutine BasicPETSc_destroy() - use spectral_utilities, only: & - Utilities_destroy - - implicit none - PetscErrorCode :: ierr - - call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) - call SNESDestroy(snes,ierr); CHKERRQ(ierr) - call DMDestroy(da,ierr); CHKERRQ(ierr) - -end subroutine BasicPETSc_destroy - -end module spectral_mech_basic diff --git a/code/spectral_mech_Polarisation.f90 b/code/spectral_mech_Polarisation.f90 deleted file mode 100644 index a28eb5adb..000000000 --- a/code/spectral_mech_Polarisation.f90 +++ /dev/null @@ -1,712 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Polarisation scheme solver -!-------------------------------------------------------------------------------------------------- -module spectral_mech_Polarisation - use prec, only: & - pInt, & - pReal - use math, only: & - math_I3 - use spectral_utilities, only: & - tSolutionState, & - tSolutionParams - - implicit none - private -#include - - character (len=*), parameter, public :: & - DAMASK_spectral_solverPolarisation_label = 'polarisation' - -!-------------------------------------------------------------------------------------------------- -! derived types - type(tSolutionParams), private :: params - real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! PETSc data - DM, private :: da - SNES, private :: snes - Vec, private :: solution_vec - -!-------------------------------------------------------------------------------------------------- -! common pointwise data - real(pReal), private, dimension(:,:,:,:,:), allocatable :: & - F_lastInc, & !< field of previous compatible deformation gradients - F_tau_lastInc, & !< field of previous incompatible deformation gradient - Fdot, & !< field of assumed rate of compatible deformation gradient - F_tauDot !< field of assumed rate of incopatible deformation gradient - -!-------------------------------------------------------------------------------------------------- -! stress, stiffness and compliance average etc. - real(pReal), private, dimension(3,3) :: & - F_aimDot, & !< assumed rate of average deformation gradient - F_aim = math_I3, & !< current prescribed deformation gradient - F_aim_lastInc = math_I3, & !< previous average deformation gradient - F_av = 0.0_pReal, & !< average incompatible def grad field - P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress - P_avLastEval = 0.0_pReal !< average 1st Piola--Kirchhoff stress last call of CPFEM_general - character(len=1024), private :: incInfo !< time and increment information - real(pReal), private, dimension(3,3,3,3) :: & - C_volAvg = 0.0_pReal, & !< current volume average stiffness - C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness - C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness - S = 0.0_pReal, & !< current compliance (filled up with zeros) - C_scale = 0.0_pReal, & - S_scale = 0.0_pReal - - real(pReal), private :: & - err_BC, & !< deviation from stress BC - err_curl, & !< RMS of curl of F - err_div !< RMS of div of P - logical, private :: ForwardData - integer(pInt), private :: & - totalIter = 0_pInt !< total iteration in current increment - - public :: & - Polarisation_init, & - Polarisation_solution, & - Polarisation_forward, & - Polarisation_destroy - external :: & - VecDestroy, & - DMDestroy, & - DMDACreate3D, & - DMCreateGlobalVector, & - DMDASNESSetFunctionLocal, & - PETScFinalize, & - SNESDestroy, & - SNESGetNumberFunctionEvals, & - SNESGetIterationNumber, & - SNESSolve, & - SNESSetDM, & - SNESGetConvergedReason, & - SNESSetConvergenceTest, & - SNESSetFromOptions, & - SNESCreate, & - MPI_Abort, & - MPI_Bcast, & - MPI_Allreduce - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields and fills them with data, potentially from restart info -!> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc) -!-------------------------------------------------------------------------------------------------- -subroutine Polarisation_init - 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_intOut, & - IO_read_realFile, & - IO_timeStamp - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRestart - use FEsolving, only: & - restartInc - use numerics, only: & - worldrank, & - worldsize - use DAMASK_interface, only: & - getSolverJobName - use spectral_utilities, only: & - Utilities_constitutiveResponse, & - Utilities_updateGamma, & - Utilities_updateIPcoords - use mesh, only: & - grid, & - grid3 - use math, only: & - math_invSym3333 - - implicit none - real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P - real(pReal), dimension(3,3) :: & - temp33_Real = 0.0_pReal - - PetscErrorCode :: ierr - PetscObject :: dummy - PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_tau - integer(pInt), dimension(:), allocatable :: localK - integer(pInt) :: proc - character(len=1024) :: rankStr - - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif - -!-------------------------------------------------------------------------------------------------- -! allocate global fields - allocate (F_lastInc (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (Fdot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (F_tau_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (F_tauDot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - -!-------------------------------------------------------------------------------------------------- -! PETSc Init - call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - call DMDACreate3d(PETSC_COMM_WORLD, & - DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary - DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - grid(1),grid(2),grid(3), & ! global grid - 1 , 1, worldsize, & - 18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap) - grid (1),grid (2),localK, & ! local grid - da,ierr) ! handle, error - CHKERRQ(ierr) - call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,dummy,ierr) - CHKERRQ(ierr) - call SNESSetConvergenceTest(snes,Polarisation_converged,dummy,PETSC_NULL_FUNCTION,ierr) - CHKERRQ(ierr) - call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) - -!-------------------------------------------------------------------------------------------------- -! init fields - call DMDAVecGetArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! places pointer xx_psc on PETSc data - F => xx_psc(0:8,:,:,:) - F_tau => xx_psc(9:17,:,:,:) - restart: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & - write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading values of increment', restartInc - 1_pInt, 'from file' - flush(6) - write(rankStr,'(a1,i0)')'_',worldrank - call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) - read (777,rec=1) F - close (777) - call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc - close (777) - call IO_read_realFile(777,'F_tau'//trim(rankStr),trim(getSolverJobName()),size(F_tau)) - read (777,rec=1) F_tau - close (777) - call IO_read_realFile(777,'F_tau_lastInc'//trim(rankStr),& - trim(getSolverJobName()),size(F_tau_lastInc)) - read (777,rec=1) F_tau_lastInc - close (777) - call IO_read_realFile(777,'F_aim', trim(getSolverJobName()),size(F_aim)) - read (777,rec=1) F_aim - close (777) - call IO_read_realFile(777,'F_aim_lastInc', trim(getSolverJobName()),size(F_aim_lastInc)) - read (777,rec=1) F_aim_lastInc - close (777) - call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) - read (777,rec=1) f_aimDot - close (777) - elseif (restartInc == 1_pInt) then restart - F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity - F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) - F_tau = 2.0_pReal* F - F_tau_lastInc = 2.0_pReal*F_lastInc - endif restart - - call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) - nullify(F) - nullify(F_tau) - call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc - - readRestart: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & - write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading more values of increment', restartInc - 1_pInt, 'from file' - flush(6) - call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg - close (777) - call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc - close (777) - call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg - close (777) - endif readRestart - - call Utilities_updateGamma(C_minMaxAvg,.True.) - C_scale = C_minMaxAvg - S_scale = math_invSym3333(C_minMaxAvg) - -end subroutine Polarisation_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief solution for the Polarisation scheme with internal iterations -!-------------------------------------------------------------------------------------------------- -type(tSolutionState) function & - Polarisation_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,rotation_BC) - use IO, only: & - IO_error - use numerics, only: & - update_gamma - use math, only: & - math_invSym3333 - use spectral_utilities, only: & - tBoundaryCondition, & - Utilities_maskedCompliance, & - Utilities_updateGamma - use FEsolving, only: & - restartWrite, & - terminallyIll - - implicit none - -!-------------------------------------------------------------------------------------------------- -! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old, & !< increment in time of last increment - loadCaseTime !< remaining time of current load case - logical, intent(in) :: & - guess - type(tBoundaryCondition), intent(in) :: & - P_BC, & - F_BC - character(len=*), intent(in) :: & - incInfoIn - real(pReal), dimension(3,3), intent(in) :: rotation_BC - -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason - - incInfo = incInfoIn - -!-------------------------------------------------------------------------------------------------- -! update stiffness (and gamma operator) - S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C_volAvg) - if (update_gamma) then - call Utilities_updateGamma(C_minMaxAvg,restartWrite) - C_scale = C_minMaxAvg - S_scale = math_invSym3333(C_minMaxAvg) - endif - -!-------------------------------------------------------------------------------------------------- -! set module wide availabe data - mask_stress = P_BC%maskFloat - params%P_BC = P_BC%values - params%rotation_BC = rotation_BC - params%timeinc = timeinc - params%timeincOld = timeinc_old - -!-------------------------------------------------------------------------------------------------- -! solve BVP - call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) - CHKERRQ(ierr) - -!-------------------------------------------------------------------------------------------------- -! check convergence - call SNESGetConvergedReason(snes,reason,ierr) - CHKERRQ(ierr) - Polarisation_solution%termIll = terminallyIll - terminallyIll = .false. - if (reason == -4) call IO_error(893_pInt) - if (reason < 1) Polarisation_solution%converged = .false. - Polarisation_solution%iterationsNeeded = totalIter - -end function Polarisation_solution - - -!-------------------------------------------------------------------------------------------------- -!> @brief forms the Polarisation residual vector -!-------------------------------------------------------------------------------------------------- -subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) - use numerics, only: & - itmax, & - itmin, & - polarAlpha, & - polarBeta, & - worldrank - use mesh, only: & - grid3, & - grid - use IO, only: & - IO_intOut - use math, only: & - math_rotate_backward33, & - math_transpose33, & - math_mul3333xx33, & - math_invSym3333, & - math_mul33x33 - use spectral_utilities, only: & - wgt, & - tensorField_real, & - utilities_FFTtensorForward, & - utilities_fourierGammaConvolution, & - utilities_FFTtensorBackward, & - Utilities_constitutiveResponse, & - Utilities_divergenceRMS, & - Utilities_curlRMS - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRotation - use homogenization, only: & - materialpoint_dPdF - use FEsolving, only: & - terminallyIll - - implicit none -!-------------------------------------------------------------------------------------------------- -! strange syntax in the next line because otherwise macros expand beyond 132 character limit - DMDALocalInfo, dimension(& - DMDA_LOCAL_INFO_SIZE) :: & - in - PetscScalar, target, dimension(3,3,2, & - XG_RANGE,YG_RANGE,ZG_RANGE) :: & - x_scal - PetscScalar, target, dimension(3,3,2, & - X_RANGE,Y_RANGE,Z_RANGE) :: & - f_scal - PetscScalar, pointer, dimension(:,:,:,:,:) :: & - F, & - F_tau, & - residual_F, & - residual_F_tau - PetscInt :: & - PETScIter, & - nfuncs - PetscObject :: dummy - PetscErrorCode :: ierr - integer(pInt) :: & - i, j, k, e - - F => x_scal(1:3,1:3,1,& - XG_RANGE,YG_RANGE,ZG_RANGE) - F_tau => x_scal(1:3,1:3,2,& - XG_RANGE,YG_RANGE,ZG_RANGE) - residual_F => f_scal(1:3,1:3,1,& - X_RANGE,Y_RANGE,Z_RANGE) - residual_F_tau => f_scal(1:3,1:3,2,& - X_RANGE,Y_RANGE,Z_RANGE) - - call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) - call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) - - F_av = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt - call MPI_Allreduce(MPI_IN_PLACE,F_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - - if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment - newIteration: if(totalIter <= PETScIter) then -!-------------------------------------------------------------------------------------------------- -! report begin of new iteration - totalIter = totalIter + 1_pInt - if (worldrank == 0_pInt) then - write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & - ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & - math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & - math_transpose33(F_aim) - flush(6) - endif - endif newIteration - -!-------------------------------------------------------------------------------------------------- -! - tensorField_real = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - tensorField_real(1:3,1:3,i,j,k) = & - polarBeta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -& - polarAlpha*math_mul33x33(F(1:3,1:3,i,j,k), & - math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3)) - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! doing convolution in Fourier space - call utilities_FFTtensorForward() - call utilities_fourierGammaConvolution(math_rotate_backward33(polarBeta*F_aim,params%rotation_BC)) - call utilities_FFTtensorBackward() - -!-------------------------------------------------------------------------------------------------- -! constructing residual - residual_F_tau = polarBeta*F - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) - -!-------------------------------------------------------------------------------------------------- -! evaluate constitutive response - P_avLastEval = P_av - call Utilities_constitutiveResponse(F_lastInc,F - residual_F_tau/polarBeta,params%timeinc, & - residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) - call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) - ForwardData = .False. - -!-------------------------------------------------------------------------------------------------- -! calculate divergence - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = residual_F - call utilities_FFTtensorForward() - err_div = Utilities_divergenceRMS() - call utilities_FFTtensorBackward() - -!-------------------------------------------------------------------------------------------------- -! constructing residual - e = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - e = e + 1_pInt - residual_F(1:3,1:3,i,j,k) = & - math_mul3333xx33(math_invSym3333(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), & - residual_F(1:3,1:3,i,j,k) - math_mul33x33(F(1:3,1:3,i,j,k), & - math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3))) & - + residual_F_tau(1:3,1:3,i,j,k) - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! calculating curl - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = F - call utilities_FFTtensorForward() - err_curl = Utilities_curlRMS() - call utilities_FFTtensorBackward() - -end subroutine Polarisation_formResidual - - -!-------------------------------------------------------------------------------------------------- -!> @brief convergence check -!-------------------------------------------------------------------------------------------------- -subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) - use numerics, only: & - itmax, & - itmin, & - err_div_tolRel, & - err_div_tolAbs, & - err_curl_tolRel, & - err_curl_tolAbs, & - err_stress_tolAbs, & - err_stress_tolRel, & - worldrank - use math, only: & - math_mul3333xx33 - use FEsolving, only: & - terminallyIll - - implicit none - SNES :: snes_local - PetscInt :: PETScIter - PetscReal :: & - xnorm, & - snorm, & - fnorm - SNESConvergedReason :: reason - PetscObject :: dummy - PetscErrorCode ::ierr - real(pReal) :: & - curlTol, & - divTol, & - BC_tol - -!-------------------------------------------------------------------------------------------------- -! stress BC handling - F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc - err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + & - mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc - -!-------------------------------------------------------------------------------------------------- -! error calculation - curlTol = max(maxval(abs(F_aim-math_I3))*err_curl_tolRel,err_curl_tolAbs) - divTol = max(maxval(abs(P_av)) *err_div_tolRel,err_div_tolAbs) - BC_tol = max(maxval(abs(P_av)) *err_stress_tolrel,err_stress_tolabs) - - converged: if ((totalIter >= itmin .and. & - all([ err_div/divTol, & - err_curl/curlTol, & - err_BC/BC_tol ] < 1.0_pReal)) & - .or. terminallyIll) then - reason = 1 - elseif (totalIter >= itmax) then converged - reason = -1 - else converged - reason = 0 - endif converged - -!-------------------------------------------------------------------------------------------------- -! report -if (worldrank == 0_pInt) then - write(6,'(1/,a)') ' ... reporting .............................................................' - write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & - err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' - write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & - err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' - write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & - err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' - write(6,'(/,a)') ' ===========================================================================' - flush(6) -endif - -end subroutine Polarisation_converged - -!-------------------------------------------------------------------------------------------------- -!> @brief forwarding routine -!-------------------------------------------------------------------------------------------------- -subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_BC) - use math, only: & - math_mul33x33, & - math_mul3333xx33, & - math_transpose33, & - math_rotate_backward33 - use numerics, only: & - worldrank - use mesh, only: & - grid3, & - grid - use spectral_utilities, only: & - Utilities_calculateRate, & - Utilities_forwardField, & - Utilities_updateIPcoords, & - tBoundaryCondition, & - cutBack - use IO, only: & - IO_write_JobRealFile - use FEsolving, only: & - restartWrite - - implicit none - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & - P_BC, & - F_BC - real(pReal), dimension(3,3), intent(in) :: rotation_BC - logical, intent(in) :: & - guess - PetscErrorCode :: ierr - PetscScalar, dimension(:,:,:,:), pointer :: xx_psc, F, F_tau - integer(pInt) :: i, j, k - real(pReal), dimension(3,3) :: F_lambda33 - character(len=1024) :: rankStr - -!-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call DMDAVecGetArrayF90(da,solution_vec,xx_psc,ierr) - F => xx_psc(0:8,:,:,:) - F_tau => xx_psc(9:17,:,:,:) - if (restartWrite) then - if (worldrank == 0_pInt) write(6,'(/,a)') ' writing converged results for restart' - flush(6) - write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F - close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc - close (777) - call IO_write_jobRealFile(777,'F_tau'//trim(rankStr),size(F_tau)) ! writing deformation gradient field to file - write (777,rec=1) F_tau - close (777) - call IO_write_jobRealFile(777,'F_tau_lastInc'//trim(rankStr),size(F_tau_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_tau_lastInc - close (777) - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'F_aim',size(F_aim)) - write (777,rec=1) F_aim - close(777) - call IO_write_jobRealFile(777,'F_aim_lastInc',size(F_aim_lastInc)) - write (777,rec=1) F_aim_lastInc - close (777) - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot - close(777) - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg - close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc - close(777) - endif - endif - call utilities_updateIPcoords(F) - - if (cutBack) then - F_aim = F_aim_lastInc - F_tau= reshape(F_tau_lastInc,[9,grid(1),grid(2),grid3]) - F = reshape(F_lastInc, [9,grid(1),grid(2),grid3]) - C_volAvg = C_volAvgLastInc - else - ForwardData = .True. - C_volAvgLastInc = C_volAvg -!-------------------------------------------------------------------------------------------------- -! calculate rate for aim - if (F_BC%myType=='l') then ! calculate f_aimDot from given L and current F - f_aimDot = F_BC%maskFloat * math_mul33x33(F_BC%values, F_aim) - elseif(F_BC%myType=='fdot') then ! f_aimDot is prescribed - f_aimDot = F_BC%maskFloat * F_BC%values - elseif(F_BC%myType=='f') then ! aim at end of load case is prescribed - f_aimDot = F_BC%maskFloat * (F_BC%values -F_aim)/loadCaseTime - endif - if (guess) f_aimDot = f_aimDot + P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old - F_aim_lastInc = F_aim - -!-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc, & - reshape(F,[3,3,grid(1),grid(2),grid3])) - F_tauDot = Utilities_calculateRate(math_rotate_backward33(2.0_pReal*f_aimDot,rotation_BC), & - timeinc_old,guess,F_tau_lastInc, & - reshape(F_tau,[3,3,grid(1),grid(2),grid3])) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) - F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3]) - endif - - F_aim = F_aim + f_aimDot * timeinc - -!-------------------------------------------------------------------------------------------------- -! update local deformation gradient - F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim - math_rotate_backward33(F_aim,rotation_BC)), & - [9,grid(1),grid(2),grid3]) - F_tau = reshape(Utilities_forwardField(timeinc,F_tau_lastInc,F_taudot), & ! does not have any average value as boundary condition - [9,grid(1),grid(2),grid3]) - if (.not. guess) then ! large strain forwarding - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3]) - F_lambda33 = math_mul3333xx33(S_scale,math_mul33x33(F_lambda33, & - math_mul3333xx33(C_scale,& - math_mul33x33(math_transpose33(F_lambda33),& - F_lambda33) -math_I3))*0.5_pReal)& - + math_I3 - F_tau(1:9,i,j,k) = reshape(F_lambda33,[9])+F(1:9,i,j,k) - enddo; enddo; enddo - endif - call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) - -end subroutine Polarisation_forward - -!-------------------------------------------------------------------------------------------------- -!> @brief destroy routine -!-------------------------------------------------------------------------------------------------- -subroutine Polarisation_destroy() - use spectral_utilities, only: & - Utilities_destroy - - implicit none - PetscErrorCode :: ierr - - call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) - call SNESDestroy(snes,ierr); CHKERRQ(ierr) - call DMDestroy(da,ierr); CHKERRQ(ierr) - -end subroutine Polarisation_destroy - -end module spectral_mech_Polarisation diff --git a/code/spectral_thermal.f90 b/code/spectral_thermal.f90 deleted file mode 100644 index 843642394..000000000 --- a/code/spectral_thermal.f90 +++ /dev/null @@ -1,419 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id: spectral_thermal.f90 4082 2015-04-11 20:28:07Z MPIE\m.diehl $ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Shaokang Zhang, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Spectral solver for thermal conduction -!-------------------------------------------------------------------------------------------------- -module spectral_thermal - use prec, only: & - pInt, & - pReal - use math, only: & - math_I3 - use spectral_utilities, only: & - tSolutionState, & - tSolutionParams - use numerics, only: & - worldrank, & - worldsize - - implicit none - private -#include - - character (len=*), parameter, public :: & - spectral_thermal_label = 'spectralthermal' - -!-------------------------------------------------------------------------------------------------- -! derived types - type(tSolutionParams), private :: params - -!-------------------------------------------------------------------------------------------------- -! PETSc data - SNES, private :: thermal_snes - Vec, private :: solution - PetscInt, private :: xstart, xend, ystart, yend, zstart, zend - real(pReal), private, dimension(:,:,:), allocatable :: & - temperature_current, & !< field of current temperature - temperature_lastInc, & !< field of previous temperature - temperature_stagInc !< field of staggered temperature - -!-------------------------------------------------------------------------------------------------- -! reference diffusion tensor, mobility etc. - integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment - real(pReal), dimension(3,3), private :: D_ref - real(pReal), private :: mobility_ref - character(len=1024), private :: incInfo - - public :: & - spectral_thermal_init, & - spectral_thermal_solution, & - spectral_thermal_forward, & - spectral_thermal_destroy - external :: & - VecDestroy, & - DMDestroy, & - DMDACreate3D, & - DMCreateGlobalVector, & - DMDASNESSetFunctionLocal, & - PETScFinalize, & - SNESDestroy, & - SNESGetNumberFunctionEvals, & - SNESGetIterationNumber, & - SNESSolve, & - SNESSetDM, & - SNESGetConvergedReason, & - SNESSetConvergenceTest, & - SNESSetFromOptions, & - SNESCreate, & - MPI_Abort, & - MPI_Bcast, & - MPI_Allreduce - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields and fills them with data, potentially from restart info -!-------------------------------------------------------------------------------------------------- -subroutine spectral_thermal_init - 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_intOut, & - IO_read_realFile, & - IO_timeStamp - use spectral_utilities, only: & - wgt - use mesh, only: & - grid, & - grid3 - use thermal_conduction, only: & - thermal_conduction_getConductivity33, & - thermal_conduction_getMassDensity, & - thermal_conduction_getSpecificHeat - use material, only: & - mappingHomogenization, & - temperature, & - thermalMapping - - implicit none - integer(pInt), dimension(:), allocatable :: localK - integer(pInt) :: proc - integer(pInt) :: i, j, k, cell - DM :: thermal_grid - PetscScalar, pointer :: x_scal(:,:,:) - PetscErrorCode :: ierr - PetscObject :: dummy - - mainProcess: if (worldrank == 0_pInt) then - write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - -!-------------------------------------------------------------------------------------------------- -! initialize solver specific parts of PETSc - call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - call DMDACreate3d(PETSC_COMM_WORLD, & - DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary - DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - grid(1),grid(2),grid(3), & ! global grid - 1, 1, worldsize, & - 1, 0, & ! #dof (temperature field), ghost boundary width (domain overlap) - grid (1),grid(2),localK, & ! local grid - thermal_grid,ierr) ! handle, error - CHKERRQ(ierr) - call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da - call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,dummy,ierr) ! residual vector of same shape as solution vector - CHKERRQ(ierr) - call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments - -!-------------------------------------------------------------------------------------------------- -! init fields - call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) - CHKERRQ(ierr) - xend = xstart + xend - 1 - yend = ystart + yend - 1 - zend = zstart + zend - 1 - allocate(temperature_current(grid(1),grid(2),grid3), source=0.0_pReal) - allocate(temperature_lastInc(grid(1),grid(2),grid3), source=0.0_pReal) - allocate(temperature_stagInc(grid(1),grid(2),grid3), source=0.0_pReal) - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - temperature_current(i,j,k) = temperature(mappingHomogenization(2,1,cell))% & - p(thermalMapping(mappingHomogenization(2,1,cell))%p(1,cell)) - temperature_lastInc(i,j,k) = temperature_current(i,j,k) - temperature_stagInc(i,j,k) = temperature_current(i,j,k) - enddo; enddo; enddo - call DMDAVecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with - x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current - call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) - - cell = 0_pInt - D_ref = 0.0_pReal - mobility_ref = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - D_ref = D_ref + thermal_conduction_getConductivity33(1,cell) - mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* & - thermal_conduction_getSpecificHeat(1,cell) - enddo; enddo; enddo - D_ref = D_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - mobility_ref = mobility_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - -end subroutine spectral_thermal_init - -!-------------------------------------------------------------------------------------------------- -!> @brief solution for the Basic PETSC scheme with internal iterations -!-------------------------------------------------------------------------------------------------- -type(tSolutionState) function spectral_thermal_solution(guess,timeinc,timeinc_old,loadCaseTime) - use numerics, only: & - itmax, & - err_thermal_tolAbs, & - err_thermal_tolRel - use spectral_utilities, only: & - tBoundaryCondition, & - Utilities_maskedCompliance, & - Utilities_updateGamma - use mesh, only: & - grid, & - grid3 - use thermal_conduction, only: & - thermal_conduction_putTemperatureAndItsRate - - implicit none - -!-------------------------------------------------------------------------------------------------- -! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old, & !< increment in time of last increment - loadCaseTime !< remaining time of current load case - logical, intent(in) :: guess - integer(pInt) :: i, j, k, cell - PetscInt :: position - PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm - -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason - - spectral_thermal_solution%converged =.false. - -!-------------------------------------------------------------------------------------------------- -! set module wide availabe data - params%timeinc = timeinc - params%timeincOld = timeinc_old - - call SNESSolve(thermal_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) - call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr) - - if (reason < 1) then - spectral_thermal_solution%converged = .false. - spectral_thermal_solution%iterationsNeeded = itmax - else - spectral_thermal_solution%converged = .true. - spectral_thermal_solution%iterationsNeeded = totalIter - endif - stagNorm = maxval(abs(temperature_current - temperature_stagInc)) - solnNorm = maxval(abs(temperature_current)) - call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - temperature_stagInc = temperature_current - spectral_thermal_solution%stagConverged = stagNorm < err_thermal_tolAbs & - .or. stagNorm < err_thermal_tolRel*solnNorm - -!-------------------------------------------------------------------------------------------------- -! updating thermal state - cell = 0_pInt !< material point = 0 - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt !< material point increase - call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), & - (temperature_current(i,j,k)-temperature_lastInc(i,j,k))/params%timeinc, & - 1,cell) - enddo; enddo; enddo - - call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr) - call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) - if (worldrank == 0) then - if (spectral_thermal_solution%converged) & - write(6,'(/,a)') ' ... thermal conduction converged ..................................' - write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature = ',& - minTemperature, maxTemperature, stagNorm - write(6,'(/,a)') ' ===========================================================================' - flush(6) - endif - -end function spectral_thermal_solution - - -!-------------------------------------------------------------------------------------------------- -!> @brief forms the spectral thermal residual vector -!-------------------------------------------------------------------------------------------------- -subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr) - use mesh, only: & - grid, & - grid3 - use math, only: & - math_mul33x3 - use spectral_utilities, only: & - scalarField_real, & - vectorField_real, & - utilities_FFTvectorForward, & - utilities_FFTvectorBackward, & - utilities_FFTscalarForward, & - utilities_FFTscalarBackward, & - utilities_fourierGreenConvolution, & - utilities_fourierScalarGradient, & - utilities_fourierVectorDivergence - use thermal_conduction, only: & - thermal_conduction_getSourceAndItsTangent, & - thermal_conduction_getConductivity33, & - thermal_conduction_getMassDensity, & - thermal_conduction_getSpecificHeat - - implicit none - DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & - in - PetscScalar, dimension( & - XG_RANGE,YG_RANGE,ZG_RANGE) :: & - x_scal - PetscScalar, dimension( & - X_RANGE,Y_RANGE,Z_RANGE) :: & - f_scal - PetscObject :: dummy - PetscErrorCode :: ierr - integer(pInt) :: i, j, k, cell - real(pReal) :: Tdot, dTdot_dT - - temperature_current = x_scal -!-------------------------------------------------------------------------------------------------- -! evaluate polarization field - scalarField_real = 0.0_pReal - scalarField_real(1:grid(1),1:grid(2),1:grid3) = temperature_current - call utilities_FFTscalarForward() - call utilities_fourierScalarGradient() !< calculate gradient of damage field - call utilities_FFTvectorBackward() - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - vectorField_real(1:3,i,j,k) = math_mul33x3(thermal_conduction_getConductivity33(1,cell) - D_ref, & - vectorField_real(1:3,i,j,k)) - enddo; enddo; enddo - call utilities_FFTvectorForward() - call utilities_fourierVectorDivergence() !< calculate damage divergence in fourier field - call utilities_FFTscalarBackward() - cell = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, temperature_current(i,j,k), 1, cell) - scalarField_real(i,j,k) = params%timeinc*scalarField_real(i,j,k) + & - params%timeinc*Tdot + & - thermal_conduction_getMassDensity (1,cell)* & - thermal_conduction_getSpecificHeat(1,cell)*(temperature_lastInc(i,j,k) - & - temperature_current(i,j,k)) + & - mobility_ref*temperature_current(i,j,k) - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! convolution of damage field with green operator - call utilities_FFTscalarForward() - call utilities_fourierGreenConvolution(D_ref, mobility_ref, params%timeinc) - call utilities_FFTscalarBackward() - -!-------------------------------------------------------------------------------------------------- -! constructing residual - f_scal = temperature_current - scalarField_real(1:grid(1),1:grid(2),1:grid3) - -end subroutine spectral_thermal_formResidual - -!-------------------------------------------------------------------------------------------------- -!> @brief forwarding routine -!-------------------------------------------------------------------------------------------------- -subroutine spectral_thermal_forward(guess,timeinc,timeinc_old,loadCaseTime) - use mesh, only: & - grid, & - grid3 - use spectral_utilities, only: & - cutBack, & - wgt - use thermal_conduction, only: & - thermal_conduction_putTemperatureAndItsRate, & - thermal_conduction_getConductivity33, & - thermal_conduction_getMassDensity, & - thermal_conduction_getSpecificHeat - - implicit none - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - logical, intent(in) :: guess - integer(pInt) :: i, j, k, cell - DM :: dm_local - PetscScalar, pointer :: x_scal(:,:,:) - PetscErrorCode :: ierr - - if (cutBack) then - temperature_current = temperature_lastInc - temperature_stagInc = temperature_lastInc - -!-------------------------------------------------------------------------------------------------- -! reverting thermal field state - cell = 0_pInt !< material point = 0 - call SNESGetDM(thermal_snes,dm_local,ierr); CHKERRQ(ierr) - call DMDAVecGetArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with - x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current - call DMDAVecRestoreArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr) - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt !< material point increase - call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), & - (temperature_current(i,j,k) - & - temperature_lastInc(i,j,k))/params%timeinc, & - 1,cell) - enddo; enddo; enddo - else -!-------------------------------------------------------------------------------------------------- -! update rate and forward last inc - temperature_lastInc = temperature_current - cell = 0_pInt - D_ref = 0.0_pReal - mobility_ref = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1) - cell = cell + 1_pInt - D_ref = D_ref + thermal_conduction_getConductivity33(1,cell) - mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* & - thermal_conduction_getSpecificHeat(1,cell) - enddo; enddo; enddo - D_ref = D_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - mobility_ref = mobility_ref*wgt - call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - endif - - end subroutine spectral_thermal_forward - -!-------------------------------------------------------------------------------------------------- -!> @brief destroy routine -!-------------------------------------------------------------------------------------------------- -subroutine spectral_thermal_destroy() - - implicit none - PetscErrorCode :: ierr - - call VecDestroy(solution,ierr); CHKERRQ(ierr) - call SNESDestroy(thermal_snes,ierr); CHKERRQ(ierr) - -end subroutine spectral_thermal_destroy - -end module spectral_thermal diff --git a/code/spectral_utilities.f90 b/code/spectral_utilities.f90 deleted file mode 100644 index bde088ccb..000000000 --- a/code/spectral_utilities.f90 +++ /dev/null @@ -1,1262 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Utilities used by the different spectral solver variants -!-------------------------------------------------------------------------------------------------- -module spectral_utilities - use, intrinsic :: iso_c_binding - use prec, only: & - pReal, & - pInt - use math, only: & - math_I3 - - implicit none - private -#include - include 'fftw3-mpi.f03' - - logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill - integer(pInt), public, parameter :: maxPhaseFields = 2_pInt - integer(pInt), public :: nActiveFields = 0_pInt - -!-------------------------------------------------------------------------------------------------- -! field labels information - enum, bind(c) - enumerator :: FIELD_UNDEFINED_ID, & - FIELD_MECH_ID, & - FIELD_THERMAL_ID, & - FIELD_DAMAGE_ID, & - FIELD_VACANCYDIFFUSION_ID - end enum - -!-------------------------------------------------------------------------------------------------- -! grid related information information - real(pReal), public :: wgt !< weighting factor 1/Nelems - -!-------------------------------------------------------------------------------------------------- -! variables storing information for spectral method and FFTW - integer(pInt), public :: grid1Red !< grid(1)/2 - real (C_DOUBLE), public, dimension(:,:,:,:,:), pointer :: tensorField_real !< real representation (some stress or deformation) of field_fourier - complex(C_DOUBLE_COMPLEX),public, dimension(:,:,:,:,:), pointer :: tensorField_fourier !< field on which the Fourier transform operates - real(C_DOUBLE), public, dimension(:,:,:,:), pointer :: vectorField_real !< vector field real representation for fftw - complex(C_DOUBLE_COMPLEX),public, dimension(:,:,:,:), pointer :: vectorField_fourier !< vector field fourier representation for fftw - real(C_DOUBLE), public, dimension(:,:,:), pointer :: scalarField_real !< scalar field real representation for fftw - complex(C_DOUBLE_COMPLEX),public, dimension(:,:,:), pointer :: scalarField_fourier !< scalar field fourier representation for fftw - complex(pReal), private, dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method - complex(pReal), private, dimension(:,:,:,:), allocatable :: xi1st !< wave vector field for first derivatives - complex(pReal), private, dimension(:,:,:,:), allocatable :: xi2nd !< wave vector field for second derivatives - real(pReal), private, dimension(3,3,3,3) :: C_ref !< mechanic reference stiffness - real(pReal), protected, public, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence (Basic, Basic PETSc) - -!-------------------------------------------------------------------------------------------------- -! plans for FFTW - type(C_PTR), private :: & - planTensorForth, & !< FFTW MPI plan P(x) to P(k) - planTensorBack, & !< FFTW MPI plan F(k) to F(x) - planVectorForth, & !< FFTW MPI plan v(x) to v(k) - planVectorBack, & !< FFTW MPI plan v(k) to v(x) - planScalarForth, & !< FFTW MPI plan s(x) to s(k) - planScalarBack !< FFTW MPI plan s(k) to s(x) - -!-------------------------------------------------------------------------------------------------- -! variables controlling debugging - logical, private :: & - debugGeneral, & !< general debugging of spectral solver - debugRotation, & !< also printing out results in lab frame - debugPETSc !< use some in debug defined options for more verbose PETSc solution - -!-------------------------------------------------------------------------------------------------- -! derived types - type, public :: tSolutionState !< return type of solution from spectral solver variants - logical :: converged = .true. - logical :: regrid = .false. - logical :: stagConverged = .true. - logical :: termIll = .false. - integer(pInt) :: iterationsNeeded = 0_pInt - end type tSolutionState - - type, public :: tBoundaryCondition !< set of parameters defining a boundary condition - real(pReal), dimension(3,3) :: values = 0.0_pReal - real(pReal), dimension(3,3) :: maskFloat = 0.0_pReal - logical, dimension(3,3) :: maskLogical = .false. - character(len=64) :: myType = 'None' - end type tBoundaryCondition - - type, public :: tLoadCase - real(pReal), dimension (3,3) :: rotation = math_I3 !< rotation of BC - type(tBoundaryCondition) :: P, & !< stress BC - deformation !< deformation BC (Fdot or L) - real(pReal) :: time = 0.0_pReal !< length of increment - integer(pInt) :: incs = 0_pInt, & !< number of increments - outputfrequency = 1_pInt, & !< frequency of result writes - restartfrequency = 0_pInt, & !< frequency of restart writes - logscale = 0_pInt !< linear/logarithmic time inc flag - logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase - integer(kind(FIELD_UNDEFINED_ID)), allocatable :: ID(:) - end type tLoadCase - - type, public :: tSolutionParams !< @todo use here the type definition for a full loadcase including mask - real(pReal), dimension(3,3) :: P_BC, rotation_BC - real(pReal) :: timeinc - real(pReal) :: timeincOld - real(pReal) :: density - end type tSolutionParams - - type(tSolutionParams), private :: params - - type, public :: phaseFieldDataBin !< set of parameters defining a phase field - real(pReal) :: diffusion = 0.0_pReal, & !< thermal conductivity - mobility = 0.0_pReal, & !< thermal mobility - phaseField0 = 0.0_pReal !< homogeneous damage field starting condition - logical :: active = .false. - character(len=64) :: label = '' - end type phaseFieldDataBin - - enum, bind(c) - enumerator :: DERIVATIVE_CONTINUOUS_ID, & - DERIVATIVE_CENTRAL_DIFF_ID, & - DERIVATIVE_FWBW_DIFF_ID - end enum - integer(kind(DERIVATIVE_CONTINUOUS_ID)) :: & - spectral_derivative_ID - - public :: & - utilities_init, & - utilities_updateGamma, & - utilities_FFTtensorForward, & - utilities_FFTtensorBackward, & - utilities_FFTvectorForward, & - utilities_FFTvectorBackward, & - utilities_FFTscalarForward, & - utilities_FFTscalarBackward, & - utilities_fourierGammaConvolution, & - utilities_fourierGreenConvolution, & - utilities_divergenceRMS, & - utilities_curlRMS, & - utilities_fourierScalarGradient, & - utilities_fourierVectorDivergence, & - utilities_fourierVectorGradient, & - utilities_fourierTensorDivergence, & - utilities_maskedCompliance, & - utilities_constitutiveResponse, & - utilities_calculateRate, & - utilities_forwardField, & - utilities_destroy, & - utilities_updateIPcoords, & - FIELD_UNDEFINED_ID, & - FIELD_MECH_ID, & - FIELD_THERMAL_ID, & - FIELD_DAMAGE_ID - private :: & - utilities_getFreqDerivative - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, sets debug flags, create plans for FFTW -!> @details Sets the debug levels for general, divergence, restart and FFTW from the biwise coding -!> provided by the debug module to logicals. -!> Allocates all fields used by FFTW and create the corresponding plans depending on the debug -!> level chosen. -!> Initializes FFTW. -!-------------------------------------------------------------------------------------------------- -subroutine utilities_init() - 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_error, & - IO_warning, & - IO_timeStamp, & - IO_open_file - use numerics, only: & - spectral_derivative, & - fftw_planner_flag, & - fftw_timelimit, & - memory_efficient, & - petsc_defaultOptions, & - petsc_options, & - divergence_correction, & - worldrank - use debug, only: & - debug_level, & - debug_SPECTRAL, & - debug_LEVELBASIC, & - debug_SPECTRALDIVERGENCE, & - debug_SPECTRALFFTW, & - debug_SPECTRALPETSC, & - debug_SPECTRALROTATION - use debug, only: & - PETSCDEBUG - use math - use mesh, only: & - grid, & - grid3, & - grid3Offset, & - geomSize - - implicit none - - external :: & - PETScOptionsClear, & - PETScOptionsInsertString, & - MPI_Abort - - PetscErrorCode :: ierr - integer(pInt) :: i, j, k - integer(pInt), dimension(3) :: k_s - type(C_PTR) :: & - tensorField, & !< field containing data for FFTW in real and fourier space (in place) - vectorField, & !< field containing data for FFTW in real space when debugging FFTW (no in place) - scalarField !< field containing data for FFTW in real space when debugging FFTW (no in place) - integer(C_INTPTR_T), dimension(3) :: gridFFTW - integer(C_INTPTR_T) :: alloc_local, local_K, local_K_offset - integer(C_INTPTR_T), parameter :: & - scalarSize = 1_C_INTPTR_T, & - vecSize = 3_C_INTPTR_T, & - tensorSize = 9_C_INTPTR_T - - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - -!-------------------------------------------------------------------------------------------------- -! set debugging parameters - debugGeneral = iand(debug_level(debug_SPECTRAL),debug_LEVELBASIC) /= 0 - debugRotation = iand(debug_level(debug_SPECTRAL),debug_SPECTRALROTATION) /= 0 - debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0 - - if(debugPETSc .and. worldrank == 0_pInt) write(6,'(3(/,a),/)') & - ' Initializing PETSc with debug options: ', & - trim(PETScDebug), & - ' add more using the PETSc_Options keyword in numerics.config ' - flush(6) - call PetscOptionsClear(ierr); CHKERRQ(ierr) - if(debugPETSc) call PetscOptionsInsertString(trim(PETSCDEBUG),ierr); CHKERRQ(ierr) - call PetscOptionsInsertString(trim(petsc_defaultOptions),ierr); CHKERRQ(ierr) - call PetscOptionsInsertString(trim(petsc_options),ierr); CHKERRQ(ierr) - - grid1Red = grid(1)/2_pInt + 1_pInt - wgt = 1.0/real(product(grid),pReal) - - if (worldrank == 0) then - write(6,'(a,3(i12 ))') ' grid a b c: ', grid - write(6,'(a,3(es12.5))') ' size x y z: ', geomSize - endif - - select case (spectral_derivative) - case ('continuous') ! default, no weighting - spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID - case ('central_difference') ! cosine curve with 1 for avg and zero for highest freq - spectral_derivative_ID = DERIVATIVE_CENTRAL_DIFF_ID - case ('fwbw_difference') ! gradient, might need grid scaling as for cosine filter - spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID - case default - call IO_error(892_pInt,ext_msg=trim(spectral_derivative)) - end select - -!-------------------------------------------------------------------------------------------------- -! scale dimension to calculate either uncorrected, dimension-independent, or dimension- and -! resolution-independent divergence - if (divergence_correction == 1_pInt) then - do j = 1_pInt, 3_pInt - if (j /= minloc(geomSize,1) .and. j /= maxloc(geomSize,1)) & - scaledGeomSize = geomSize/geomSize(j) - enddo - elseif (divergence_correction == 2_pInt) then - do j = 1_pInt, 3_pInt - if (j /= minloc(geomSize/grid,1) .and. j /= maxloc(geomSize/grid,1)) & - scaledGeomSize = geomSize/geomSize(j)*grid(j) - enddo - else - scaledGeomSize = geomSize - endif - - -!-------------------------------------------------------------------------------------------------- -! MPI allocation - gridFFTW = int(grid,C_INTPTR_T) - alloc_local = fftw_mpi_local_size_3d(gridFFTW(3), gridFFTW(2), gridFFTW(1)/2 +1, & - MPI_COMM_WORLD, local_K, local_K_offset) - allocate (xi1st (3,grid1Red,grid(2),grid3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies, only half the size for first dimension - allocate (xi2nd (3,grid1Red,grid(2),grid3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies, only half the size for first dimension - - tensorField = fftw_alloc_complex(tensorSize*alloc_local) - call c_f_pointer(tensorField, tensorField_real, [3_C_INTPTR_T,3_C_INTPTR_T, & - 2_C_INTPTR_T*(gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),gridFFTW(2),local_K]) ! place a pointer for a real tensor representation - call c_f_pointer(tensorField, tensorField_fourier, [3_C_INTPTR_T,3_C_INTPTR_T, & - gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T , gridFFTW(2),local_K]) ! place a pointer for a fourier tensor representation - - vectorField = fftw_alloc_complex(vecSize*alloc_local) - call c_f_pointer(vectorField, vectorField_real, [3_C_INTPTR_T,& - 2_C_INTPTR_T*(gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T),gridFFTW(2),local_K]) ! place a pointer for a real vector representation - call c_f_pointer(vectorField, vectorField_fourier,[3_C_INTPTR_T,& - gridFFTW(1)/2_C_INTPTR_T + 1_C_INTPTR_T, gridFFTW(2),local_K]) ! place a pointer for a fourier vector representation - - scalarField = fftw_alloc_complex(scalarSize*alloc_local) ! allocate data for real representation (no in place transform) - call c_f_pointer(scalarField, scalarField_real, & - [2_C_INTPTR_T*(gridFFTW(1)/2_C_INTPTR_T + 1),gridFFTW(2),local_K]) ! place a pointer for a real scalar representation - call c_f_pointer(scalarField, scalarField_fourier, & - [ gridFFTW(1)/2_C_INTPTR_T + 1 ,gridFFTW(2),local_K]) ! place a pointer for a fourier scarlar representation - -!-------------------------------------------------------------------------------------------------- -! tensor MPI fftw plans - planTensorForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order - tensorSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock - tensorField_real, tensorField_fourier, & ! input data, output data - MPI_COMM_WORLD, fftw_planner_flag) ! use all processors, planer precision - if (.not. C_ASSOCIATED(planTensorForth)) call IO_error(810, ext_msg='planTensorForth') - planTensorBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order - tensorSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock - tensorField_fourier,tensorField_real, & ! input data, output data - MPI_COMM_WORLD, fftw_planner_flag) ! all processors, planer precision - if (.not. C_ASSOCIATED(planTensorBack)) call IO_error(810, ext_msg='planTensorBack') - -!-------------------------------------------------------------------------------------------------- -! vector MPI fftw plans - planVectorForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order - vecSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock - vectorField_real, vectorField_fourier, & ! input data, output data - MPI_COMM_WORLD, fftw_planner_flag) ! use all processors, planer precision - if (.not. C_ASSOCIATED(planVectorForth)) call IO_error(810, ext_msg='planVectorForth') - planVectorBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order - vecSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & ! no. of transforms, default iblock and oblock - vectorField_fourier,vectorField_real, & ! input data, output data - MPI_COMM_WORLD, fftw_planner_flag) ! all processors, planer precision - if (.not. C_ASSOCIATED(planVectorBack)) call IO_error(810, ext_msg='planVectorBack') - -!-------------------------------------------------------------------------------------------------- -! scalar MPI fftw plans - planScalarForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order - scalarSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & ! no. of transforms, default iblock and oblock - scalarField_real, scalarField_fourier, & ! input data, output data - MPI_COMM_WORLD, fftw_planner_flag) ! use all processors, planer precision - if (.not. C_ASSOCIATED(planScalarForth)) call IO_error(810, ext_msg='planScalarForth') - planScalarBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order, no. of transforms - scalarSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & ! no. of transforms, default iblock and oblock - scalarField_fourier,scalarField_real, & ! input data, output data - MPI_COMM_WORLD, fftw_planner_flag) ! use all processors, planer precision - if (.not. C_ASSOCIATED(planScalarBack)) call IO_error(810, ext_msg='planScalarBack') - -!-------------------------------------------------------------------------------------------------- -! general initialization of FFTW (see manual on fftw.org for more details) - if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(0_pInt,ext_msg='Fortran to C') ! check for correct precision in C - call fftw_set_timelimit(fftw_timelimit) ! set timelimit for plan creation - - if (debugGeneral .and. worldrank == 0_pInt) write(6,'(/,a)') ' FFTW initialized' - flush(6) - -!-------------------------------------------------------------------------------------------------- -! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) - do k = grid3Offset+1_pInt, grid3Offset+grid3 - k_s(3) = k - 1_pInt - if(k > grid(3)/2_pInt + 1_pInt) k_s(3) = k_s(3) - grid(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 - do j = 1_pInt, grid(2) - k_s(2) = j - 1_pInt - if(j > grid(2)/2_pInt + 1_pInt) k_s(2) = k_s(2) - grid(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 - do i = 1_pInt, grid1Red - k_s(1) = i - 1_pInt ! symmetry, junst running from 0,1,...,N/2,N/2+1 - xi2nd(1:3,i,j,k-grid3Offset) = utilities_getFreqDerivative(k_s) ! if divergence_correction is set, frequencies are calculated on unit length - where(mod(grid,2)==0 .and. [i,j,k] == grid/2+1 .and. & - spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID) ! for even grids, set the Nyquist Freq component to 0.0 - xi1st(1:3,i,j,k-grid3Offset) = cmplx(0.0_pReal,0.0_pReal,pReal) - elsewhere - xi1st(1:3,i,j,k-grid3Offset) = xi2nd(1:3,i,j,k-grid3Offset) - endwhere - enddo; enddo; enddo - - if(memory_efficient) then ! allocate just single fourth order tensor - allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pReal,0.0_pReal,pReal)) - else ! precalculation of gamma_hat field - allocate (gamma_hat(3,3,3,3,grid1Red,grid(2),grid3), source = cmplx(0.0_pReal,0.0_pReal,pReal)) - endif - -end subroutine utilities_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief updates references stiffness and potentially precalculated gamma operator -!> @details Sets the current reference stiffness to the stiffness given as an argument. -!> If the gamma operator is precalculated, it is calculated with this stiffness. -!> In case of a on-the-fly calculation, only the reference stiffness is updated. -!> Also writes out the current reference stiffness for restart. -!-------------------------------------------------------------------------------------------------- -subroutine utilities_updateGamma(C,saveReference) - use IO, only: & - IO_write_jobRealFile - use numerics, only: & - memory_efficient, & - worldrank - use mesh, only: & - grid3Offset, & - grid3,& - grid - use math, only: & - math_det33, & - math_invert - - implicit none - real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness - logical , intent(in) :: saveReference !< save reference stiffness to file for restart - complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx - real(pReal), dimension(6,6) :: matA, matInvA - integer(pInt) :: & - i, j, k, & - l, m, n, o - logical :: ierr - - C_ref = C - if (saveReference) then - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' writing reference stiffness to file' - flush(6) - call IO_write_jobRealFile(777,'C_ref',size(C_ref)) - write (777,rec=1) C_ref - close(777) - endif - endif - - if(.not. memory_efficient) then - gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A - do k = grid3Offset+1_pInt, grid3Offset+grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red - if (any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset) - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_complex(l,m) = sum(C_ref(l,1:3,m,1:3)*xiDyad_cmplx) - matA(1:3,1:3) = real(temp33_complex); matA(4:6,4:6) = real(temp33_complex) - matA(1:3,4:6) = aimag(temp33_complex); matA(4:6,1:3) = -aimag(temp33_complex) - if (abs(math_det33(matA(1:3,1:3))) > 1e-16) then - call math_invert(6_pInt, matA, matInvA, ierr) - temp33_complex = cmplx(matInvA(1:3,1:3),matInvA(1:3,4:6),pReal) - forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt) & - gamma_hat(l,m,n,o,i,j,k-grid3Offset) = temp33_complex(l,n)* & - conjg(-xi1st(o,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset) - endif - endif - enddo; enddo; enddo - endif - -end subroutine utilities_updateGamma - -!-------------------------------------------------------------------------------------------------- -!> @brief forward FFT of data in field_real to field_fourier -!> @details Does an unweighted filtered FFT transform from real to complex -!-------------------------------------------------------------------------------------------------- -subroutine utilities_FFTtensorForward() - implicit none - -!-------------------------------------------------------------------------------------------------- -! doing the tensor FFT - call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier) - -end subroutine utilities_FFTtensorForward - - -!-------------------------------------------------------------------------------------------------- -!> @brief backward FFT of data in field_fourier to field_real -!> @details Does an weighted inverse FFT transform from complex to real -!-------------------------------------------------------------------------------------------------- -subroutine utilities_FFTtensorBackward() - implicit none - - call fftw_mpi_execute_dft_c2r(planTensorBack,tensorField_fourier,tensorField_real) - tensorField_real = tensorField_real * wgt ! normalize the result by number of elements - -end subroutine utilities_FFTtensorBackward - -!-------------------------------------------------------------------------------------------------- -!> @brief forward FFT of data in scalarField_real to scalarField_fourier -!> @details Does an unweighted filtered FFT transform from real to complex -!-------------------------------------------------------------------------------------------------- -subroutine utilities_FFTscalarForward() - implicit none - -!-------------------------------------------------------------------------------------------------- -! doing the scalar FFT - call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier) - -end subroutine utilities_FFTscalarForward - - -!-------------------------------------------------------------------------------------------------- -!> @brief backward FFT of data in scalarField_fourier to scalarField_real -!> @details Does an weighted inverse FFT transform from complex to real -!-------------------------------------------------------------------------------------------------- -subroutine utilities_FFTscalarBackward() - implicit none - - call fftw_mpi_execute_dft_c2r(planScalarBack,scalarField_fourier,scalarField_real) - scalarField_real = scalarField_real * wgt ! normalize the result by number of elements - -end subroutine utilities_FFTscalarBackward - - -!-------------------------------------------------------------------------------------------------- -!> @brief forward FFT of data in field_real to field_fourier with highest freqs. removed -!> @details Does an unweighted filtered FFT transform from real to complex. -!-------------------------------------------------------------------------------------------------- -subroutine utilities_FFTvectorForward() - implicit none - -!-------------------------------------------------------------------------------------------------- -! doing the vector FFT - call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier) - -end subroutine utilities_FFTvectorForward - - -!-------------------------------------------------------------------------------------------------- -!> @brief backward FFT of data in field_fourier to field_real -!> @details Does an weighted inverse FFT transform from complex to real -!-------------------------------------------------------------------------------------------------- -subroutine utilities_FFTvectorBackward() - implicit none - - call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real) - vectorField_real = vectorField_real * wgt ! normalize the result by number of elements - -end subroutine utilities_FFTvectorBackward - - -!-------------------------------------------------------------------------------------------------- -!> @brief doing convolution gamma_hat * field_real, ensuring that average value = fieldAim -!-------------------------------------------------------------------------------------------------- -subroutine utilities_fourierGammaConvolution(fieldAim) - use numerics, only: & - memory_efficient - use math, only: & - math_det33, & - math_invert - use numerics, only: & - worldrank - use mesh, only: & - grid3, & - grid, & - grid3Offset - - implicit none - real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution - complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx - real(pReal) :: matA(6,6), matInvA(6,6) - - integer(pInt) :: & - i, j, k, & - l, m, n, o - logical :: ierr - - - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' ... doing gamma convolution ...............................................' - flush(6) - endif - -!-------------------------------------------------------------------------------------------------- -! do the actual spectral method calculation (mechanical equilibrium) - memoryEfficient: if(memory_efficient) then - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red - if (any([i,j,k+grid3Offset] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k) - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_complex(l,m) = sum(C_ref(l,1:3,m,1:3)*xiDyad_cmplx) - matA(1:3,1:3) = real(temp33_complex); matA(4:6,4:6) = real(temp33_complex) - matA(1:3,4:6) = aimag(temp33_complex); matA(4:6,1:3) = -aimag(temp33_complex) - if (abs(math_det33(matA(1:3,1:3))) > 1e-16) then - call math_invert(6_pInt, matA, matInvA, ierr) - temp33_complex = cmplx(matInvA(1:3,1:3),matInvA(1:3,4:6),pReal) - forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt) & - gamma_hat(l,m,n,o,1,1,1) = temp33_complex(l,n)*conjg(-xi1st(o,i,j,k))*xi1st(m,i,j,k) - else - gamma_hat(1:3,1:3,1:3,1:3,1,1,1) = cmplx(0.0_pReal,0.0_pReal,pReal) - endif - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,j,k)) - tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex - endif - enddo; enddo; enddo - else memoryEfficient - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid1Red - forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & - temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,j,k) * tensorField_fourier(1:3,1:3,i,j,k)) - tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex - enddo; enddo; enddo - endif memoryEfficient - - if (grid3Offset == 0_pInt) & - tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim/wgt,0.0_pReal,pReal) - -end subroutine utilities_fourierGammaConvolution - - -!-------------------------------------------------------------------------------------------------- -!> @brief doing convolution DamageGreenOp_hat * field_real -!-------------------------------------------------------------------------------------------------- -subroutine utilities_fourierGreenConvolution(D_ref, mobility_ref, deltaT) - - use math, only: & - math_mul33x3, & - PI - use mesh, only: & - grid, & - grid3 - - implicit none - real(pReal), dimension(3,3), intent(in) :: D_ref !< desired average value of the field after convolution - real(pReal), intent(in) :: mobility_ref, deltaT !< desired average value of the field after convolution - complex(pReal) :: GreenOp_hat - integer(pInt) :: i, j, k - -!-------------------------------------------------------------------------------------------------- -! do the actual spectral method calculation - do k = 1_pInt, grid3; do j = 1_pInt, grid(2) ;do i = 1_pInt, grid1Red - GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal)/ & - (cmplx(mobility_ref,0.0_pReal,pReal) + & - deltaT*sum(conjg(xi1st(1:3,i,j,k))*matmul(D_ref,xi1st(1:3,i,j,k)))) ! why not use dot_product - scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k)*GreenOp_hat - enddo; enddo; enddo - -end subroutine utilities_fourierGreenConvolution - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate root mean square of divergence of field_fourier -!-------------------------------------------------------------------------------------------------- -real(pReal) function utilities_divergenceRMS() - use numerics, only: & - worldrank - use mesh, only: & - geomSize, & - grid, & - grid3 - - implicit none - integer(pInt) :: i, j, k - PetscErrorCode :: ierr - - external :: & - MPI_Allreduce - - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' ... calculating divergence ................................................' - flush(6) - endif - -!-------------------------------------------------------------------------------------------------- -! calculating RMS divergence criterion in Fourier space - utilities_divergenceRMS = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2) - do i = 2_pInt, grid1Red -1_pInt ! Has somewhere a conj. complex counterpart. Therefore count it twice. - utilities_divergenceRMS = utilities_divergenceRMS & - + 2.0_pReal*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,j,k),& ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2. do not take square root and square again - conjg(-xi1st(1:3,i,j,k))*geomSize/scaledGeomSize))**2.0_pReal)& ! --> sum squared L_2 norm of vector - +sum(aimag(matmul(tensorField_fourier(1:3,1:3,i,j,k),& - conjg(-xi1st(1:3,i,j,k))*geomSize/scaledGeomSize))**2.0_pReal)) - enddo - utilities_divergenceRMS = utilities_divergenceRMS & ! these two layers (DC and Nyquist) do not have a conjugate complex counterpart (if grid(1) /= 1) - + sum( real(matmul(tensorField_fourier(1:3,1:3,1 ,j,k), & - conjg(-xi1st(1:3,1,j,k))*geomSize/scaledGeomSize))**2.0_pReal) & - + sum(aimag(matmul(tensorField_fourier(1:3,1:3,1 ,j,k), & - conjg(-xi1st(1:3,1,j,k))*geomSize/scaledGeomSize))**2.0_pReal) & - + sum( real(matmul(tensorField_fourier(1:3,1:3,grid1Red,j,k), & - conjg(-xi1st(1:3,grid1Red,j,k))*geomSize/scaledGeomSize))**2.0_pReal) & - + sum(aimag(matmul(tensorField_fourier(1:3,1:3,grid1Red,j,k), & - conjg(-xi1st(1:3,grid1Red,j,k))*geomSize/scaledGeomSize))**2.0_pReal) - enddo; enddo - if(grid(1) == 1_pInt) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal ! counted twice in case of grid(1) == 1 - call MPI_Allreduce(MPI_IN_PLACE,utilities_divergenceRMS,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - utilities_divergenceRMS = sqrt(utilities_divergenceRMS) * wgt ! RMS in real space calculated with Parsevals theorem from Fourier space - - -end function utilities_divergenceRMS - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate max of curl of field_fourier -!-------------------------------------------------------------------------------------------------- -real(pReal) function utilities_curlRMS() - use numerics, only: & - worldrank - use mesh, only: & - geomSize, & - grid, & - grid3 - - implicit none - integer(pInt) :: i, j, k, l - complex(pReal), dimension(3,3) :: curl_fourier - PetscErrorCode :: ierr - - external :: & - MPI_Reduce, & - MPI_Allreduce - - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' ... calculating curl ......................................................' - flush(6) - endif - - !-------------------------------------------------------------------------------------------------- -! calculating max curl criterion in Fourier space - utilities_curlRMS = 0.0_pReal - - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); - do i = 2_pInt, grid1Red - 1_pInt - do l = 1_pInt, 3_pInt - curl_fourier(l,1) = (+tensorField_fourier(l,3,i,j,k)*xi1st(2,i,j,k)*geomSize(2)/scaledGeomSize(2) & - -tensorField_fourier(l,2,i,j,k)*xi1st(3,i,j,k)*geomSize(3)/scaledGeomSize(3)) - curl_fourier(l,2) = (+tensorField_fourier(l,1,i,j,k)*xi1st(3,i,j,k)*geomSize(3)/scaledGeomSize(3) & - -tensorField_fourier(l,3,i,j,k)*xi1st(1,i,j,k)*geomSize(1)/scaledGeomSize(1)) - curl_fourier(l,3) = (+tensorField_fourier(l,2,i,j,k)*xi1st(1,i,j,k)*geomSize(1)/scaledGeomSize(1) & - -tensorField_fourier(l,1,i,j,k)*xi1st(2,i,j,k)*geomSize(2)/scaledGeomSize(2)) - enddo - utilities_curlRMS = utilities_curlRMS + & - 2.0_pReal*sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! Has somewhere a conj. complex counterpart. Therefore count it twice. - enddo - do l = 1_pInt, 3_pInt - curl_fourier = (+tensorField_fourier(l,3,1,j,k)*xi1st(2,1,j,k)*geomSize(2)/scaledGeomSize(2) & - -tensorField_fourier(l,2,1,j,k)*xi1st(3,1,j,k)*geomSize(3)/scaledGeomSize(3)) - curl_fourier = (+tensorField_fourier(l,1,1,j,k)*xi1st(3,1,j,k)*geomSize(3)/scaledGeomSize(3) & - -tensorField_fourier(l,3,1,j,k)*xi1st(1,1,j,k)*geomSize(1)/scaledGeomSize(1)) - curl_fourier = (+tensorField_fourier(l,2,1,j,k)*xi1st(1,1,j,k)*geomSize(1)/scaledGeomSize(1) & - -tensorField_fourier(l,1,1,j,k)*xi1st(2,1,j,k)*geomSize(2)/scaledGeomSize(2)) - enddo - utilities_curlRMS = utilities_curlRMS + & - sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! this layer (DC) does not have a conjugate complex counterpart (if grid(1) /= 1) - do l = 1_pInt, 3_pInt - curl_fourier = (+tensorField_fourier(l,3,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*geomSize(2)/scaledGeomSize(2) & - -tensorField_fourier(l,2,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*geomSize(3)/scaledGeomSize(3)) - curl_fourier = (+tensorField_fourier(l,1,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*geomSize(3)/scaledGeomSize(3) & - -tensorField_fourier(l,3,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*geomSize(1)/scaledGeomSize(1)) - curl_fourier = (+tensorField_fourier(l,2,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*geomSize(1)/scaledGeomSize(1) & - -tensorField_fourier(l,1,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*geomSize(2)/scaledGeomSize(2)) - enddo - utilities_curlRMS = utilities_curlRMS + & - sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! this layer (Nyquist) does not have a conjugate complex counterpart (if grid(1) /= 1) - enddo; enddo - - call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - utilities_curlRMS = sqrt(utilities_curlRMS) * wgt - if(grid(1) == 1_pInt) utilities_curlRMS = utilities_curlRMS * 0.5_pReal ! counted twice in case of grid(1) == 1 - -end function utilities_curlRMS - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates mask compliance tensor used to adjust F to fullfill stress BC -!-------------------------------------------------------------------------------------------------- -function utilities_maskedCompliance(rot_BC,mask_stress,C) - use prec, only: & - prec_isNaN - use IO, only: & - IO_error - use numerics, only: & - worldrank - use math, only: & - math_Plain3333to99, & - math_plain99to3333, & - math_rotate_forward3333, & - math_rotate_forward33, & - math_invert - - implicit none - real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance - real(pReal), intent(in) , dimension(3,3,3,3) :: C !< current average stiffness - real(pReal), intent(in) , dimension(3,3) :: rot_BC !< rotation of load frame - logical, intent(in), dimension(3,3) :: mask_stress !< mask of stress BC - integer(pInt) :: j, k, m, n - logical, dimension(9) :: mask_stressVector - real(pReal), dimension(9,9) :: temp99_Real - integer(pInt) :: size_reduced = 0_pInt - real(pReal), dimension(:,:), allocatable :: & - s_reduced, & !< reduced compliance matrix (depending on number of stress BC) - c_reduced, & !< reduced stiffness (depending on number of stress BC) - sTimesC !< temp variable to check inversion - logical :: errmatinv - character(len=1024):: formatString - - mask_stressVector = reshape(transpose(mask_stress), [9]) - size_reduced = int(count(mask_stressVector), pInt) - if(size_reduced > 0_pInt )then - allocate (c_reduced(size_reduced,size_reduced), source =0.0_pReal) - allocate (s_reduced(size_reduced,size_reduced), source =0.0_pReal) - allocate (sTimesC(size_reduced,size_reduced), source =0.0_pReal) - temp99_Real = math_Plain3333to99(math_rotate_forward3333(C,rot_BC)) - - if(debugGeneral .and. worldrank == 0_pInt) then - write(6,'(/,a)') ' ... updating masked compliance ............................................' - write(6,'(/,a,/,9(9(2x,f12.7,1x)/))',advance='no') ' Stiffness C (load) / GPa =',& - transpose(temp99_Real)/1.e9_pReal - flush(6) - endif - k = 0_pInt ! calculate reduced stiffness - do n = 1_pInt,9_pInt - if(mask_stressVector(n)) then - k = k + 1_pInt - j = 0_pInt - do m = 1_pInt,9_pInt - if(mask_stressVector(m)) then - j = j + 1_pInt - c_reduced(k,j) = temp99_Real(n,m) - endif; enddo; endif; enddo - - call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness - if (any(prec_isNaN(s_reduced))) errmatinv = .true. - if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') - temp99_Real = 0.0_pReal ! fill up compliance with zeros - k = 0_pInt - do n = 1_pInt,9_pInt - if(mask_stressVector(n)) then - k = k + 1_pInt - j = 0_pInt - do m = 1_pInt,9_pInt - if(mask_stressVector(m)) then - j = j + 1_pInt - temp99_Real(n,m) = s_reduced(k,j) - endif; enddo; endif; enddo - -!-------------------------------------------------------------------------------------------------- -! check if inversion was successful - sTimesC = matmul(c_reduced,s_reduced) - do m=1_pInt, size_reduced - do n=1_pInt, size_reduced - if(m==n .and. abs(sTimesC(m,n)) > (1.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! diagonal elements of S*C should be 1 - if(m/=n .and. abs(sTimesC(m,n)) > (0.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! off diagonal elements of S*C should be 0 - enddo - enddo - if((debugGeneral .or. errmatinv) .and. (worldrank == 0_pInt)) then ! report - write(formatString, '(I16.16)') size_reduced - formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' - write(6,trim(formatString),advance='no') ' C * S (load) ', & - transpose(matmul(c_reduced,s_reduced)) - write(6,trim(formatString),advance='no') ' S (load) ', transpose(s_reduced) - endif - if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') - deallocate(c_reduced) - deallocate(s_reduced) - deallocate(sTimesC) - else - temp99_real = 0.0_pReal - endif - if(debugGeneral .and. worldrank == 0_pInt) & ! report - write(6,'(/,a,/,9(9(2x,f12.7,1x)/),/)',advance='no') ' Masked Compliance (load) * GPa =', & - transpose(temp99_Real*1.e9_pReal) - flush(6) - utilities_maskedCompliance = math_Plain99to3333(temp99_Real) - -end function utilities_maskedCompliance - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate scalar gradient in fourier field -!-------------------------------------------------------------------------------------------------- -subroutine utilities_fourierScalarGradient() - use mesh, only: & - grid3, & - grid - - implicit none - integer(pInt) :: i, j, k - - vectorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal) - forall(k = 1_pInt:grid3, j = 1_pInt:grid(2), i = 1_pInt:grid1Red) & - vectorField_fourier(1:3,i,j,k) = scalarField_fourier(i,j,k)*xi1st(1:3,i,j,k) - -end subroutine utilities_fourierScalarGradient - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate vector divergence in fourier field -!-------------------------------------------------------------------------------------------------- -subroutine utilities_fourierVectorDivergence() - use mesh, only: & - grid3, & - grid - - implicit none - integer(pInt) :: i, j, k - - scalarField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal) - forall(k = 1_pInt:grid3, j = 1_pInt:grid(2), i = 1_pInt:grid1Red) & - scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k) + & - sum(vectorField_fourier(1:3,i,j,k)*conjg(-xi1st(1:3,i,j,k))) - -end subroutine utilities_fourierVectorDivergence - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate vector gradient in fourier field -!-------------------------------------------------------------------------------------------------- -subroutine utilities_fourierVectorGradient() - use mesh, only: & - grid3, & - grid - - implicit none - integer(pInt) :: i, j, k, m, n - - tensorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal) - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid1Red - do m = 1_pInt, 3_pInt; do n = 1_pInt, 3_pInt - tensorField_fourier(m,n,i,j,k) = vectorField_fourier(m,i,j,k)*xi1st(n,i,j,k) - enddo; enddo - enddo; enddo; enddo -end subroutine utilities_fourierVectorGradient - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate tensor divergence in fourier field -!-------------------------------------------------------------------------------------------------- -subroutine utilities_fourierTensorDivergence() - use mesh, only: & - grid3, & - grid - - implicit none - integer(pInt) :: i, j, k, m, n - - vectorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal) - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid1Red - do m = 1_pInt, 3_pInt; do n = 1_pInt, 3_pInt - vectorField_fourier(m,i,j,k) = & - vectorField_fourier(m,i,j,k) + & - tensorField_fourier(m,n,i,j,k)*conjg(-xi1st(n,i,j,k)) - enddo; enddo - enddo; enddo; enddo -end subroutine utilities_fourierTensorDivergence - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates constitutive response -!-------------------------------------------------------------------------------------------------- -subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & - P,C_volAvg,C_minmaxAvg,P_av,forwardData,rotation_BC) - use debug, only: & - debug_reset, & - debug_info - use numerics, only: & - worldrank - use math, only: & - math_transpose33, & - math_rotate_forward33, & - math_det33 - use mesh, only: & - grid,& - grid3 - use FEsolving, only: & - restartWrite - use CPFEM2, only: & - CPFEM_general - use homogenization, only: & - materialpoint_F0, & - materialpoint_F, & - materialpoint_P, & - materialpoint_dPdF - - implicit none - real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: & - F_lastInc, & !< target deformation gradient - F !< previous deformation gradient - real(pReal), intent(in) :: timeinc !< loading time - logical, intent(in) :: forwardData !< age results - real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame - - real(pReal),intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness - real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress - real(pReal),intent(out), dimension(3,3,grid(1),grid(2),grid3) :: P !< PK stress - - logical :: & - age - - integer(pInt) :: & - j,k - real(pReal), dimension(3,3,3,3) :: max_dPdF, min_dPdF - real(pReal) :: max_dPdF_norm, min_dPdF_norm, defgradDetMin, defgradDetMax, defgradDet - PetscErrorCode :: ierr - - external :: & - MPI_Reduce, & - MPI_Allreduce - - if (worldrank == 0_pInt) then - write(6,'(/,a)') ' ... evaluating constitutive response ......................................' - flush(6) - endif - age = .False. - - if (forwardData) then ! aging results - age = .True. - materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) - endif - if (cutBack) then ! restore saved variables - age = .False. - endif - - materialpoint_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) - call debug_reset() - -!-------------------------------------------------------------------------------------------------- -! calculate bounds of det(F) and report - if(debugGeneral) then - defgradDetMax = -huge(1.0_pReal) - defgradDetMin = +huge(1.0_pReal) - do j = 1_pInt, product(grid(1:2))*grid3 - defgradDet = math_det33(materialpoint_F(1:3,1:3,1,j)) - defgradDetMax = max(defgradDetMax,defgradDet) - defgradDetMin = min(defgradDetMin,defgradDet) - end do - call MPI_reduce(MPI_IN_PLACE,defgradDetMax,1,MPI_DOUBLE,MPI_MAX,0,PETSC_COMM_WORLD,ierr) - call MPI_reduce(MPI_IN_PLACE,defgradDetMin,1,MPI_DOUBLE,MPI_MIN,0,PETSC_COMM_WORLD,ierr) - if (worldrank == 0_pInt) then - write(6,'(a,1x,es11.4)') ' max determinant of deformation =', defgradDetMax - write(6,'(a,1x,es11.4)') ' min determinant of deformation =', defgradDetMin - flush(6) - endif - endif - - call CPFEM_general(age,timeinc) - - max_dPdF = 0.0_pReal - max_dPdF_norm = 0.0_pReal - min_dPdF = huge(1.0_pReal) - min_dPdF_norm = huge(1.0_pReal) - do k = 1_pInt, product(grid(1:2))*grid3 - if (max_dPdF_norm < sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal)) then - max_dPdF = materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k) - max_dPdF_norm = sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal) - endif - if (min_dPdF_norm > sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal)) then - min_dPdF = materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k) - min_dPdF_norm = sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal) - endif - end do - - call MPI_Allreduce(MPI_IN_PLACE,max_dPdF,81,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - call MPI_Allreduce(MPI_IN_PLACE,min_dPdF,81,MPI_DOUBLE,MPI_MIN,PETSC_COMM_WORLD,ierr) - - C_minmaxAvg = 0.5_pReal*(max_dPdF + min_dPdF) - C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt - - call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - - call debug_info() - - restartWrite = .false. ! reset restartWrite status - cutBack = .false. ! reset cutBack status - - P = reshape(materialpoint_P, [3,3,grid(1),grid(2),grid3]) - P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P - call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - if (debugRotation .and. worldrank == 0_pInt) & - write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',& - math_transpose33(P_av)*1.e-6_pReal - P_av = math_rotate_forward33(P_av,rotation_BC) - if (worldrank == 0_pInt) then - write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& - math_transpose33(P_av)*1.e-6_pReal - flush(6) - endif - -end subroutine utilities_constitutiveResponse - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates forward rate, either guessing or just add delta/timeinc -!-------------------------------------------------------------------------------------------------- -pure function utilities_calculateRate(avRate,timeinc_old,guess,field_lastInc,field) - use mesh, only: & - grid3, & - grid - - implicit none - real(pReal), intent(in), dimension(3,3) :: avRate !< homogeneous addon - real(pReal), intent(in) :: & - timeinc_old !< timeinc of last step - logical, intent(in) :: & - guess !< guess along former trajectory - real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: & - field_lastInc, & !< data of previous step - field !< data of current step - real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: & - utilities_calculateRate - - if (guess) then - utilities_calculateRate = (field-field_lastInc) / timeinc_old - else - utilities_calculateRate = spread(spread(spread(avRate,3,grid(1)),4,grid(2)),5,grid3) - endif - -end function utilities_calculateRate - - -!-------------------------------------------------------------------------------------------------- -!> @brief forwards a field with a pointwise given rate, if aim is given, -!> ensures that the average matches the aim -!-------------------------------------------------------------------------------------------------- -function utilities_forwardField(timeinc,field_lastInc,rate,aim) - use mesh, only: & - grid3, & - grid - - implicit none - real(pReal), intent(in) :: & - timeinc !< timeinc of current step - real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: & - field_lastInc, & !< initial field - rate !< rate by which to forward - real(pReal), intent(in), optional, dimension(3,3) :: & - aim !< average field value aim - real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: & - utilities_forwardField - real(pReal), dimension(3,3) :: fieldDiff !< - aim - PetscErrorCode :: ierr - - external :: & - MPI_Allreduce - - utilities_forwardField = field_lastInc + rate*timeinc - if (present(aim)) then !< correct to match average - fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt - call MPI_Allreduce(MPI_IN_PLACE,fieldDiff,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - fieldDiff = fieldDiff - aim - utilities_forwardField = utilities_forwardField - & - spread(spread(spread(fieldDiff,3,grid(1)),4,grid(2)),5,grid3) - endif - -end function utilities_forwardField - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates filter for fourier convolution depending on type given in numerics.config -!-------------------------------------------------------------------------------------------------- -pure function utilities_getFreqDerivative(k_s) - use math, only: & - PI - use mesh, only: & - geomSize, & - grid - - implicit none - integer(pInt), intent(in), dimension(3) :: k_s !< indices of frequency - complex(pReal), dimension(3) :: utilities_getFreqDerivative - - select case (spectral_derivative_ID) - case (DERIVATIVE_CONTINUOUS_ID) - utilities_getFreqDerivative = cmplx(0.0_pReal, 2.0_pReal*PI*real(k_s,pReal)/geomSize,pReal) - - case (DERIVATIVE_CENTRAL_DIFF_ID) - utilities_getFreqDerivative = cmplx(0.0_pReal, sin(2.0_pReal*PI*real(k_s,pReal)/real(grid,pReal)), pReal)/ & - cmplx(2.0_pReal*geomSize/real(grid,pReal), 0.0_pReal, pReal) - - case (DERIVATIVE_FWBW_DIFF_ID) - utilities_getFreqDerivative(1) = & - cmplx(cos(2.0_pReal*PI*real(k_s(1),pReal)/real(grid(1),pReal)) - 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(1),pReal)/real(grid(1),pReal)), pReal)* & - cmplx(cos(2.0_pReal*PI*real(k_s(2),pReal)/real(grid(2),pReal)) + 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(2),pReal)/real(grid(2),pReal)), pReal)* & - cmplx(cos(2.0_pReal*PI*real(k_s(3),pReal)/real(grid(3),pReal)) + 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(3),pReal)/real(grid(3),pReal)), pReal)/ & - cmplx(4.0_pReal*geomSize(1)/real(grid(1),pReal), 0.0_pReal, pReal) - utilities_getFreqDerivative(2) = & - cmplx(cos(2.0_pReal*PI*real(k_s(1),pReal)/real(grid(1),pReal)) + 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(1),pReal)/real(grid(1),pReal)), pReal)* & - cmplx(cos(2.0_pReal*PI*real(k_s(2),pReal)/real(grid(2),pReal)) - 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(2),pReal)/real(grid(2),pReal)), pReal)* & - cmplx(cos(2.0_pReal*PI*real(k_s(3),pReal)/real(grid(3),pReal)) + 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(3),pReal)/real(grid(3),pReal)), pReal)/ & - cmplx(4.0_pReal*geomSize(2)/real(grid(2),pReal), 0.0_pReal, pReal) - utilities_getFreqDerivative(3) = & - cmplx(cos(2.0_pReal*PI*real(k_s(1),pReal)/real(grid(1),pReal)) + 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(1),pReal)/real(grid(1),pReal)), pReal)* & - cmplx(cos(2.0_pReal*PI*real(k_s(2),pReal)/real(grid(2),pReal)) + 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(2),pReal)/real(grid(2),pReal)), pReal)* & - cmplx(cos(2.0_pReal*PI*real(k_s(3),pReal)/real(grid(3),pReal)) - 1.0_pReal, & - sin(2.0_pReal*PI*real(k_s(3),pReal)/real(grid(3),pReal)), pReal)/ & - cmplx(4.0_pReal*geomSize(3)/real(grid(3),pReal), 0.0_pReal, pReal) - - end select - -end function utilities_getFreqDerivative - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate coordinates in current configuration for given defgrad field -! using integration in Fourier space. Similar as in mesh.f90, but using data already defined for -! convolution -!-------------------------------------------------------------------------------------------------- -subroutine utilities_updateIPcoords(F) - use math, only: & - math_mul33x3 - use mesh, only: & - grid, & - grid3, & - grid3Offset, & - geomSize, & - mesh_ipCoordinates - implicit none - - real(pReal), dimension(3,3,grid(1),grid(2),grid3), intent(in) :: F - integer(pInt) :: i, j, k, m - real(pReal), dimension(3) :: step, offset_coords - real(pReal), dimension(3,3) :: Favg - PetscErrorCode :: ierr - external & - MPI_Bcast - -!-------------------------------------------------------------------------------------------------- -! integration in Fourier space - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = F - call utilities_FFTtensorForward() - call utilities_fourierTensorDivergence() - - do k = 1_pInt, grid3; do j = 1_pInt, grid(2) ;do i = 1_pInt, grid1Red - if (any(abs(xi1st(1:3,i,j,k)) > tiny(0.0_pReal))) & - vectorField_fourier(1:3,i,j,k) = vectorField_fourier(1:3,i,j,k)/ & - sum(conjg(-xi1st(1:3,i,j,k))*xi1st(1:3,i,j,k)) - enddo; enddo; enddo - call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real) - -!-------------------------------------------------------------------------------------------------- -! average F - if (grid3Offset == 0_pInt) Favg = real(tensorField_fourier(1:3,1:3,1,1,1),pReal)*wgt - call MPI_Bcast(Favg,9,MPI_DOUBLE,0,PETSC_COMM_WORLD,ierr) - -!-------------------------------------------------------------------------------------------------- -! add average to fluctuation and put (0,0,0) on (0,0,0) - step = geomSize/real(grid, pReal) - if (grid3Offset == 0_pInt) offset_coords = vectorField_real(1:3,1,1,1) - call MPI_Bcast(offset_coords,3,MPI_DOUBLE,0,PETSC_COMM_WORLD,ierr) - offset_coords = math_mul33x3(Favg,step/2.0_pReal) - offset_coords - m = 1_pInt - do k = 1_pInt,grid3; do j = 1_pInt,grid(2); do i = 1_pInt,grid(1) - mesh_ipCoordinates(1:3,1,m) = vectorField_real(1:3,i,j,k) & - + offset_coords & - + math_mul33x3(Favg,step*real([i,j,k+grid3Offset]-1_pInt,pReal)) - m = m+1_pInt - enddo; enddo; enddo - -end subroutine utilities_updateIPcoords - - -!-------------------------------------------------------------------------------------------------- -!> @brief cleans up -!-------------------------------------------------------------------------------------------------- -subroutine utilities_destroy() - implicit none - - call fftw_destroy_plan(planTensorForth) - call fftw_destroy_plan(planTensorBack) - call fftw_destroy_plan(planVectorForth) - call fftw_destroy_plan(planVectorBack) - call fftw_destroy_plan(planScalarForth) - call fftw_destroy_plan(planScalarBack) - -end subroutine utilities_destroy - - -end module spectral_utilities diff --git a/code/thermal/CMakeLists.txt b/code/thermal/CMakeLists.txt index b9d3f8ff9..1d06449ef 100644 --- a/code/thermal/CMakeLists.txt +++ b/code/thermal/CMakeLists.txt @@ -8,3 +8,8 @@ set (THERMAL "thermal_isothermal" foreach (p ${THERMAL}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${THERMAL}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/thermal_adiabatic.f90 b/code/thermal_adiabatic.f90 deleted file mode 100644 index 7bb8620e7..000000000 --- a/code/thermal_adiabatic.f90 +++ /dev/null @@ -1,422 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for adiabatic temperature evolution -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module thermal_adiabatic - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - thermal_adiabatic_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - thermal_adiabatic_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - thermal_adiabatic_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - thermal_adiabatic_Noutput !< number of outputs per instance of this thermal model - - enum, bind(c) - enumerator :: undefined_ID, & - temperature_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - thermal_adiabatic_outputID !< ID of each post result output - - - public :: & - thermal_adiabatic_init, & - thermal_adiabatic_updateState, & - thermal_adiabatic_getSourceAndItsTangent, & - thermal_adiabatic_getSpecificHeat, & - thermal_adiabatic_getMassDensity, & - thermal_adiabatic_postResults - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine thermal_adiabatic_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: & - thermal_type, & - thermal_typeInstance, & - homogenization_Noutput, & - THERMAL_ADIABATIC_label, & - THERMAL_adiabatic_ID, & - material_homog, & - mappingHomogenization, & - thermalState, & - thermalMapping, & - thermal_initialT, & - temperature, & - temperatureRate, & - 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)') ' <<<+- thermal_'//THERMAL_ADIABATIC_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - - maxNinstance = int(count(thermal_type == THERMAL_adiabatic_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(thermal_adiabatic_sizePostResults(maxNinstance), source=0_pInt) - allocate(thermal_adiabatic_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(thermal_adiabatic_output (maxval(homogenization_Noutput),maxNinstance)) - thermal_adiabatic_output = '' - allocate(thermal_adiabatic_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(thermal_adiabatic_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 (thermal_type(section) == THERMAL_adiabatic_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = thermal_typeInstance(section) ! which instance of my thermal 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 ('temperature') - thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1_pInt - thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID - thermal_adiabatic_output(thermal_adiabatic_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(thermal_type) - if (thermal_type(section) == THERMAL_adiabatic_ID) then - NofMyHomog=count(material_homog==section) - instance = thermal_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,thermal_adiabatic_Noutput(instance) - select case(thermal_adiabatic_outputID(o,instance)) - case(temperature_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - thermal_adiabatic_sizePostResult(o,instance) = mySize - thermal_adiabatic_sizePostResults(instance) = thermal_adiabatic_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 1_pInt - thermalState(section)%sizeState = sizeState - thermalState(section)%sizePostResults = thermal_adiabatic_sizePostResults(instance) - allocate(thermalState(section)%state0 (sizeState,NofMyHomog), source=thermal_initialT(section)) - allocate(thermalState(section)%subState0(sizeState,NofMyHomog), source=thermal_initialT(section)) - allocate(thermalState(section)%state (sizeState,NofMyHomog), source=thermal_initialT(section)) - - nullify(thermalMapping(section)%p) - thermalMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(temperature(section)%p) - temperature(section)%p => thermalState(section)%state(1,:) - deallocate(temperatureRate(section)%p) - allocate (temperatureRate(section)%p(NofMyHomog), source=0.0_pReal) - - endif - - enddo initializeInstances -end subroutine thermal_adiabatic_init - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates adiabatic change in temperature based on local heat generation model -!-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_updateState(subdt, ip, el) - use numerics, only: & - err_thermal_tolAbs, & - err_thermal_tolRel - use material, only: & - mappingHomogenization, & - thermalState, & - temperature, & - temperatureRate, & - thermalMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - subdt - logical, dimension(2) :: & - thermal_adiabatic_updateState - integer(pInt) :: & - homog, & - offset - real(pReal) :: & - T, Tdot, dTdot_dT - - homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) - - T = thermalState(homog)%subState0(1,offset) - call thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - T = T + subdt*Tdot/(thermal_adiabatic_getSpecificHeat(ip,el)*thermal_adiabatic_getMassDensity(ip,el)) - - thermal_adiabatic_updateState = [ abs(T - thermalState(homog)%state(1,offset)) & - <= err_thermal_tolAbs & - .or. abs(T - thermalState(homog)%state(1,offset)) & - <= err_thermal_tolRel*abs(thermalState(homog)%state(1,offset)), & - .true.] - - temperature (homog)%p(thermalMapping(homog)%p(ip,el)) = T - temperatureRate(homog)%p(thermalMapping(homog)%p(ip,el)) = & - (thermalState(homog)%state(1,offset) - thermalState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal)) - -end function thermal_adiabatic_updateState - -!-------------------------------------------------------------------------------------------------- -!> @brief returns heat generation rate -!-------------------------------------------------------------------------------------------------- -subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - use math, only: & - math_Mandel6to33 - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - phaseAt, phasememberAt, & - thermal_typeInstance, & - phase_Nsources, & - phase_source, & - SOURCE_thermal_dissipation_ID, & - SOURCE_thermal_externalheat_ID - use source_thermal_dissipation, only: & - source_thermal_dissipation_getRateAndItsTangent - use source_thermal_externalheat, only: & - source_thermal_externalheat_getRateAndItsTangent - use crystallite, only: & - crystallite_Tstar_v, & - crystallite_Lp - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T - real(pReal), intent(out) :: & - Tdot, dTdot_dT - real(pReal) :: & - my_Tdot, my_dTdot_dT - integer(pInt) :: & - phase, & - homog, & - offset, & - instance, & - grain, & - source - - homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) - instance = thermal_typeInstance(homog) - - Tdot = 0.0_pReal - dTdot_dT = 0.0_pReal - do grain = 1, homogenization_Ngrains(homog) - phase = phaseAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_thermal_dissipation_ID) - call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - crystallite_Tstar_v(1:6,grain,ip,el), & - crystallite_Lp(1:3,1:3,grain,ip,el), & - grain, ip, el) - - case (SOURCE_thermal_externalheat_ID) - call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - grain, ip, el) - - case default - my_Tdot = 0.0_pReal - my_dTdot_dT = 0.0_pReal - end select - Tdot = Tdot + my_Tdot - dTdot_dT = dTdot_dT + my_dTdot_dT - enddo - enddo - - Tdot = Tdot/homogenization_Ngrains(homog) - dTdot_dT = dTdot_dT/homogenization_Ngrains(homog) - -end subroutine thermal_adiabatic_getSourceAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized specific heat capacity -!-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_getSpecificHeat(ip,el) - use lattice, only: & - lattice_specificHeat - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - 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) :: & - thermal_adiabatic_getSpecificHeat - integer(pInt) :: & - homog, grain - - thermal_adiabatic_getSpecificHeat = 0.0_pReal - - homog = mappingHomogenization(2,ip,el) - - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat + & - lattice_specificHeat(material_phase(grain,ip,el)) - enddo - - thermal_adiabatic_getSpecificHeat = & - thermal_adiabatic_getSpecificHeat/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function thermal_adiabatic_getSpecificHeat - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized mass density -!-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_getMassDensity(ip,el) - use lattice, only: & - lattice_massDensity - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - 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) :: & - thermal_adiabatic_getMassDensity - integer(pInt) :: & - homog, grain - - thermal_adiabatic_getMassDensity = 0.0_pReal - - homog = mappingHomogenization(2,ip,el) - - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity + & - lattice_massDensity(material_phase(grain,ip,el)) - enddo - - thermal_adiabatic_getMassDensity = & - thermal_adiabatic_getMassDensity/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function thermal_adiabatic_getMassDensity - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of thermal results -!-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_postResults(ip,el) - use material, only: & - mappingHomogenization, & - thermal_typeInstance, & - thermalMapping, & - temperature - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(thermal_adiabatic_sizePostResults(thermal_typeInstance(mappingHomogenization(2,ip,el)))) :: & - thermal_adiabatic_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = thermalMapping(homog)%p(ip,el) - instance = thermal_typeInstance(homog) - - c = 0_pInt - thermal_adiabatic_postResults = 0.0_pReal - - do o = 1_pInt,thermal_adiabatic_Noutput(instance) - select case(thermal_adiabatic_outputID(o,instance)) - - case (temperature_ID) - thermal_adiabatic_postResults(c+1_pInt) = temperature(homog)%p(offset) - c = c + 1 - end select - enddo -end function thermal_adiabatic_postResults - -end module thermal_adiabatic diff --git a/code/thermal_conduction.f90 b/code/thermal_conduction.f90 deleted file mode 100644 index 2f9b766eb..000000000 --- a/code/thermal_conduction.f90 +++ /dev/null @@ -1,444 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for temperature evolution from heat conduction -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module thermal_conduction - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - thermal_conduction_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - thermal_conduction_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - thermal_conduction_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - thermal_conduction_Noutput !< number of outputs per instance of this damage - - enum, bind(c) - enumerator :: undefined_ID, & - temperature_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - thermal_conduction_outputID !< ID of each post result output - - - public :: & - thermal_conduction_init, & - thermal_conduction_getSourceAndItsTangent, & - thermal_conduction_getConductivity33, & - thermal_conduction_getSpecificHeat, & - thermal_conduction_getMassDensity, & - thermal_conduction_putTemperatureAndItsRate, & - thermal_conduction_postResults - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_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: & - thermal_type, & - thermal_typeInstance, & - homogenization_Noutput, & - THERMAL_conduction_label, & - THERMAL_conduction_ID, & - material_homog, & - mappingHomogenization, & - thermalState, & - thermalMapping, & - thermal_initialT, & - temperature, & - temperatureRate, & - 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)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - - maxNinstance = int(count(thermal_type == THERMAL_conduction_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(thermal_conduction_sizePostResults(maxNinstance), source=0_pInt) - allocate(thermal_conduction_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(thermal_conduction_output (maxval(homogenization_Noutput),maxNinstance)) - thermal_conduction_output = '' - allocate(thermal_conduction_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(thermal_conduction_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 (thermal_type(section) == THERMAL_conduction_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = thermal_typeInstance(section) ! which instance of my thermal 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 ('temperature') - thermal_conduction_Noutput(instance) = thermal_conduction_Noutput(instance) + 1_pInt - thermal_conduction_outputID(thermal_conduction_Noutput(instance),instance) = temperature_ID - thermal_conduction_output(thermal_conduction_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(thermal_type) - if (thermal_type(section) == THERMAL_conduction_ID) then - NofMyHomog=count(material_homog==section) - instance = thermal_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,thermal_conduction_Noutput(instance) - select case(thermal_conduction_outputID(o,instance)) - case(temperature_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - thermal_conduction_sizePostResult(o,instance) = mySize - thermal_conduction_sizePostResults(instance) = thermal_conduction_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 0_pInt - thermalState(section)%sizeState = sizeState - thermalState(section)%sizePostResults = thermal_conduction_sizePostResults(instance) - allocate(thermalState(section)%state0 (sizeState,NofMyHomog)) - allocate(thermalState(section)%subState0(sizeState,NofMyHomog)) - allocate(thermalState(section)%state (sizeState,NofMyHomog)) - - nullify(thermalMapping(section)%p) - thermalMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(temperature (section)%p) - allocate (temperature (section)%p(NofMyHomog), source=thermal_initialT(section)) - deallocate(temperatureRate(section)%p) - allocate (temperatureRate(section)%p(NofMyHomog), source=0.0_pReal) - - endif - - enddo initializeInstances -end subroutine thermal_conduction_init - -!-------------------------------------------------------------------------------------------------- -!> @brief returns heat generation rate -!-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - use math, only: & - math_Mandel6to33 - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - phaseAt, phasememberAt, & - thermal_typeInstance, & - phase_Nsources, & - phase_source, & - SOURCE_thermal_dissipation_ID, & - SOURCE_thermal_externalheat_ID - use source_thermal_dissipation, only: & - source_thermal_dissipation_getRateAndItsTangent - use source_thermal_externalheat, only: & - source_thermal_externalheat_getRateAndItsTangent - use crystallite, only: & - crystallite_Tstar_v, & - crystallite_Lp - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T - real(pReal), intent(out) :: & - Tdot, dTdot_dT - real(pReal) :: & - my_Tdot, my_dTdot_dT - integer(pInt) :: & - phase, & - homog, & - offset, & - instance, & - grain, & - source - - homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) - instance = thermal_typeInstance(homog) - - Tdot = 0.0_pReal - dTdot_dT = 0.0_pReal - do grain = 1, homogenization_Ngrains(homog) - phase = phaseAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_thermal_dissipation_ID) - call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - crystallite_Tstar_v(1:6,grain,ip,el), & - crystallite_Lp(1:3,1:3,grain,ip,el), & - grain, ip, el) - - case (SOURCE_thermal_externalheat_ID) - call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - grain, ip, el) - - case default - my_Tdot = 0.0_pReal - my_dTdot_dT = 0.0_pReal - - end select - Tdot = Tdot + my_Tdot - dTdot_dT = dTdot_dT + my_dTdot_dT - enddo - enddo - - Tdot = Tdot/homogenization_Ngrains(homog) - dTdot_dT = dTdot_dT/homogenization_Ngrains(homog) - -end subroutine thermal_conduction_getSourceAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized thermal conductivity in reference configuration -!-------------------------------------------------------------------------------------------------- -function thermal_conduction_getConductivity33(ip,el) - use lattice, only: & - lattice_thermalConductivity33 - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - 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) :: & - thermal_conduction_getConductivity33 - integer(pInt) :: & - homog, & - grain - - homog = mappingHomogenization(2,ip,el) - - thermal_conduction_getConductivity33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - thermal_conduction_getConductivity33 = thermal_conduction_getConductivity33 + & - crystallite_push33ToRef(grain,ip,el,lattice_thermalConductivity33(:,:,material_phase(grain,ip,el))) - enddo - - thermal_conduction_getConductivity33 = & - thermal_conduction_getConductivity33/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function thermal_conduction_getConductivity33 - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized specific heat capacity -!-------------------------------------------------------------------------------------------------- -function thermal_conduction_getSpecificHeat(ip,el) - use lattice, only: & - lattice_specificHeat - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - 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) :: & - thermal_conduction_getSpecificHeat - integer(pInt) :: & - homog, grain - - thermal_conduction_getSpecificHeat = 0.0_pReal - - homog = mappingHomogenization(2,ip,el) - - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat + & - lattice_specificHeat(material_phase(grain,ip,el)) - enddo - - thermal_conduction_getSpecificHeat = & - thermal_conduction_getSpecificHeat/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function thermal_conduction_getSpecificHeat - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized mass density -!-------------------------------------------------------------------------------------------------- -function thermal_conduction_getMassDensity(ip,el) - use lattice, only: & - lattice_massDensity - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - 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) :: & - thermal_conduction_getMassDensity - integer(pInt) :: & - homog, grain - - thermal_conduction_getMassDensity = 0.0_pReal - - homog = mappingHomogenization(2,ip,el) - - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - thermal_conduction_getMassDensity = thermal_conduction_getMassDensity + & - lattice_massDensity(material_phase(grain,ip,el)) - enddo - - thermal_conduction_getMassDensity = & - thermal_conduction_getMassDensity/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function thermal_conduction_getMassDensity - -!-------------------------------------------------------------------------------------------------- -!> @brief updates thermal state with solution from heat conduction PDE -!-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el) - use material, only: & - mappingHomogenization, & - temperature, & - temperatureRate, & - thermalMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T, & - Tdot - integer(pInt) :: & - homog, & - offset - - homog = mappingHomogenization(2,ip,el) - offset = thermalMapping(homog)%p(ip,el) - temperature (homog)%p(offset) = T - temperatureRate(homog)%p(offset) = Tdot - -end subroutine thermal_conduction_putTemperatureAndItsRate - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of thermal results -!-------------------------------------------------------------------------------------------------- -function thermal_conduction_postResults(ip,el) - use material, only: & - mappingHomogenization, & - thermal_typeInstance, & - temperature, & - thermalMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(thermal_conduction_sizePostResults(thermal_typeInstance(mappingHomogenization(2,ip,el)))) :: & - thermal_conduction_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = thermalMapping(homog)%p(ip,el) - instance = thermal_typeInstance(homog) - - c = 0_pInt - thermal_conduction_postResults = 0.0_pReal - - do o = 1_pInt,thermal_conduction_Noutput(instance) - select case(thermal_conduction_outputID(o,instance)) - - case (temperature_ID) - thermal_conduction_postResults(c+1_pInt) = temperature(homog)%p(offset) - c = c + 1 - end select - enddo -end function thermal_conduction_postResults - -end module thermal_conduction diff --git a/code/thermal_isothermal.f90 b/code/thermal_isothermal.f90 deleted file mode 100644 index 8c9d3a782..000000000 --- a/code/thermal_isothermal.f90 +++ /dev/null @@ -1,65 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for isothermal temperature field -!-------------------------------------------------------------------------------------------------- -module thermal_isothermal - - implicit none - private - - public :: & - thermal_isothermal_init - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine thermal_isothermal_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, & - sizeState - - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_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 (thermal_type(homog) == THERMAL_isothermal_ID) then - NofMyHomog = count(material_homog == homog) - sizeState = 0_pInt - thermalState(homog)%sizeState = sizeState - thermalState(homog)%sizePostResults = sizeState - allocate(thermalState(homog)%state0 (sizeState,NofMyHomog), source=0.0_pReal) - allocate(thermalState(homog)%subState0(sizeState,NofMyHomog), source=0.0_pReal) - allocate(thermalState(homog)%state (sizeState,NofMyHomog), source=0.0_pReal) - - deallocate(temperature (homog)%p) - allocate (temperature (homog)%p(1), source=thermal_initialT(homog)) - deallocate(temperatureRate(homog)%p) - allocate (temperatureRate(homog)%p(1), source=0.0_pReal) - - endif myhomog - enddo initializeInstances - - -end subroutine thermal_isothermal_init - -end module thermal_isothermal diff --git a/code/vacancyflux/CMakeLists.txt b/code/vacancyflux/CMakeLists.txt index 4a4c4f31c..43e2a75fe 100644 --- a/code/vacancyflux/CMakeLists.txt +++ b/code/vacancyflux/CMakeLists.txt @@ -8,3 +8,8 @@ set (VACANCYFLUX "vacancyflux_isoconc" foreach (p ${VACANCYFLUX}) add_library (${p} MODULE "${p}.f90") endforeach (p) + +# set libraries/modules for linking +foreach (p ${VACANCYFLUX}) + set (AUX_LIB ${AUX_LIB} ${p}) +endforeach (p) \ No newline at end of file diff --git a/code/vacancyflux_cahnhilliard.f90 b/code/vacancyflux_cahnhilliard.f90 deleted file mode 100644 index 16a380ffc..000000000 --- a/code/vacancyflux_cahnhilliard.f90 +++ /dev/null @@ -1,606 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for conservative transport of vacancy concentration field -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module vacancyflux_cahnhilliard - use prec, only: & - pReal, & - pInt, & - p_vec - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - vacancyflux_cahnhilliard_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - vacancyflux_cahnhilliard_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - vacancyflux_cahnhilliard_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - vacancyflux_cahnhilliard_Noutput !< number of outputs per instance of this damage - - real(pReal), dimension(:), allocatable, private :: & - vacancyflux_cahnhilliard_flucAmplitude - - type(p_vec), dimension(:), allocatable, private :: & - vacancyflux_cahnhilliard_thermalFluc - - real(pReal), parameter, private :: & - kB = 1.3806488e-23_pReal !< Boltzmann constant in J/Kelvin - - enum, bind(c) - enumerator :: undefined_ID, & - vacancyConc_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - vacancyflux_cahnhilliard_outputID !< ID of each post result output - - - public :: & - vacancyflux_cahnhilliard_init, & - vacancyflux_cahnhilliard_getSourceAndItsTangent, & - vacancyflux_cahnhilliard_getMobility33, & - vacancyflux_cahnhilliard_getDiffusion33, & - vacancyflux_cahnhilliard_getChemPotAndItsTangent, & - vacancyflux_cahnhilliard_putVacancyConcAndItsRate, & - vacancyflux_cahnhilliard_postResults - private :: & - vacancyflux_cahnhilliard_getFormationEnergy, & - vacancyflux_cahnhilliard_getEntropicCoeff, & - vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_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: & - vacancyflux_type, & - vacancyflux_typeInstance, & - homogenization_Noutput, & - VACANCYFLUX_cahnhilliard_label, & - VACANCYFLUX_cahnhilliard_ID, & - material_homog, & - mappingHomogenization, & - vacancyfluxState, & - vacancyfluxMapping, & - vacancyConc, & - vacancyConcRate, & - vacancyflux_initialCv, & - 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,offset - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' - - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_cahnhilliard_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - - maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(vacancyflux_cahnhilliard_sizePostResults(maxNinstance), source=0_pInt) - allocate(vacancyflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(vacancyflux_cahnhilliard_output (maxval(homogenization_Noutput),maxNinstance)) - vacancyflux_cahnhilliard_output = '' - allocate(vacancyflux_cahnhilliard_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(vacancyflux_cahnhilliard_Noutput (maxNinstance), source=0_pInt) - - allocate(vacancyflux_cahnhilliard_flucAmplitude (maxNinstance)) - allocate(vacancyflux_cahnhilliard_thermalFluc (maxNinstance)) - - 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 (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux 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 ('vacancyconc') - vacancyflux_cahnhilliard_Noutput(instance) = vacancyflux_cahnhilliard_Noutput(instance) + 1_pInt - vacancyflux_cahnhilliard_outputID(vacancyflux_cahnhilliard_Noutput(instance),instance) = vacancyConc_ID - vacancyflux_cahnhilliard_output(vacancyflux_cahnhilliard_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - case ('vacancyflux_flucamplitude') - vacancyflux_cahnhilliard_flucAmplitude(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingHomog - - initializeInstances: do section = 1_pInt, size(vacancyflux_type) - if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then - NofMyHomog=count(material_homog==section) - instance = vacancyflux_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance) - select case(vacancyflux_cahnhilliard_outputID(o,instance)) - case(vacancyConc_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - vacancyflux_cahnhilliard_sizePostResult(o,instance) = mySize - vacancyflux_cahnhilliard_sizePostResults(instance) = vacancyflux_cahnhilliard_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 0_pInt - vacancyfluxState(section)%sizeState = sizeState - vacancyfluxState(section)%sizePostResults = vacancyflux_cahnhilliard_sizePostResults(instance) - allocate(vacancyfluxState(section)%state0 (sizeState,NofMyHomog)) - allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog)) - allocate(vacancyfluxState(section)%state (sizeState,NofMyHomog)) - - allocate(vacancyflux_cahnhilliard_thermalFluc(instance)%p(NofMyHomog)) - do offset = 1_pInt, NofMyHomog - call random_number(vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset)) - vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) = & - 1.0_pReal - & - vacancyflux_cahnhilliard_flucAmplitude(instance)* & - (vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) - 0.5_pReal) - enddo - - nullify(vacancyfluxMapping(section)%p) - vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(vacancyConc (section)%p) - allocate (vacancyConc (section)%p(NofMyHomog), source=vacancyflux_initialCv(section)) - deallocate(vacancyConcRate(section)%p) - allocate (vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal) - - endif - - enddo initializeInstances - -end subroutine vacancyflux_cahnhilliard_init - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates homogenized vacancy driving forces -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el) - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - phaseAt, phasememberAt, & - phase_source, & - phase_Nsources, & - SOURCE_vacancy_phenoplasticity_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID - use source_vacancy_phenoplasticity, only: & - source_vacancy_phenoplasticity_getRateAndItsTangent - use source_vacancy_irradiation, only: & - source_vacancy_irradiation_getRateAndItsTangent - use source_vacancy_thermalfluc, only: & - source_vacancy_thermalfluc_getRateAndItsTangent - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - integer(pInt) :: & - phase, & - grain, & - source - real(pReal) :: & - CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv - - CvDot = 0.0_pReal - dCvDot_dCv = 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_vacancy_phenoplasticity_ID) - call source_vacancy_phenoplasticity_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_irradiation_ID) - call source_vacancy_irradiation_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_thermalfluc_ID) - call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip, el) - - end select - CvDot = CvDot + localCvDot - dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv - enddo - enddo - - CvDot = CvDot/homogenization_Ngrains(mappingHomogenization(2,ip,el)) - dCvDot_dCv = dCvDot_dCv/homogenization_Ngrains(mappingHomogenization(2,ip,el)) - -end subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy mobility tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function vacancyflux_cahnhilliard_getMobility33(ip,el) - use lattice, only: & - lattice_vacancyfluxMobility33 - 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) :: & - vacancyflux_cahnhilliard_getMobility33 - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getMobility33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - vacancyflux_cahnhilliard_getMobility33 = vacancyflux_cahnhilliard_getMobility33 + & - crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxMobility33(:,:,material_phase(grain,ip,el))) - enddo - - vacancyflux_cahnhilliard_getMobility33 = & - vacancyflux_cahnhilliard_getMobility33/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function vacancyflux_cahnhilliard_getMobility33 - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy diffusion tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function vacancyflux_cahnhilliard_getDiffusion33(ip,el) - use lattice, only: & - lattice_vacancyfluxDiffusion33 - 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) :: & - vacancyflux_cahnhilliard_getDiffusion33 - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getDiffusion33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - vacancyflux_cahnhilliard_getDiffusion33 = vacancyflux_cahnhilliard_getDiffusion33 + & - crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxDiffusion33(:,:,material_phase(grain,ip,el))) - enddo - - vacancyflux_cahnhilliard_getDiffusion33 = & - vacancyflux_cahnhilliard_getDiffusion33/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function vacancyflux_cahnhilliard_getDiffusion33 - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy formation energy -!-------------------------------------------------------------------------------------------------- -real(pReal) function vacancyflux_cahnhilliard_getFormationEnergy(ip,el) - use lattice, only: & - lattice_vacancyFormationEnergy, & - lattice_vacancyVol, & - 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 - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getFormationEnergy = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - vacancyflux_cahnhilliard_getFormationEnergy = vacancyflux_cahnhilliard_getFormationEnergy + & - lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ & - lattice_vacancyVol(material_phase(grain,ip,el))/ & - lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - enddo - - vacancyflux_cahnhilliard_getFormationEnergy = & - vacancyflux_cahnhilliard_getFormationEnergy/ & - homogenization_Ngrains(mesh_element(3,el)) - -end function vacancyflux_cahnhilliard_getFormationEnergy - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy entropy coefficient -!-------------------------------------------------------------------------------------------------- -real(pReal) function vacancyflux_cahnhilliard_getEntropicCoeff(ip,el) - use lattice, only: & - lattice_vacancyVol, & - lattice_vacancySurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_homog, & - material_phase, & - temperature, & - thermalMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getEntropicCoeff = 0.0_pReal - do grain = 1, homogenization_Ngrains(material_homog(ip,el)) - vacancyflux_cahnhilliard_getEntropicCoeff = vacancyflux_cahnhilliard_getEntropicCoeff + & - kB/ & - lattice_vacancyVol(material_phase(grain,ip,el))/ & - lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - enddo - - vacancyflux_cahnhilliard_getEntropicCoeff = & - vacancyflux_cahnhilliard_getEntropicCoeff* & - temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ & - homogenization_Ngrains(material_homog(ip,el)) - -end function vacancyflux_cahnhilliard_getEntropicCoeff - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized kinematic contribution to chemical potential -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el) - use lattice, only: & - lattice_vacancySurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_homog, & - phase_kinematics, & - phase_Nkinematics, & - material_phase, & - KINEMATICS_vacancy_strain_ID - use crystallite, only: & - crystallite_Tstar_v, & - crystallite_Fi0, & - crystallite_Fi - use kinematics_vacancy_strain, only: & - kinematics_vacancy_strain_ChemPotAndItsTangent - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - real(pReal), intent(out) :: & - KPot, dKPot_dCv - real(pReal) :: & - my_KPot, my_dKPot_dCv - integer(pInt) :: & - grain, kinematics - - KPot = 0.0_pReal - dKPot_dCv = 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_vacancy_strain_ID) - call kinematics_vacancy_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCv, & - 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_dCv = 0.0_pReal - - end select - KPot = KPot + my_KPot/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - dKPot_dCv = dKPot_dCv + my_dKPot_dCv/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - enddo - enddo - - KPot = KPot/homogenization_Ngrains(material_homog(ip,el)) - dKPot_dCv = dKPot_dCv/homogenization_Ngrains(material_homog(ip,el)) - -end subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized chemical potential and its tangent -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCv,Cv,ip,el) - use numerics, only: & - vacancyBoundPenalty, & - vacancyPolyOrder - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - porosity, & - porosityMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - real(pReal), intent(out) :: & - ChemPot, & - dChemPot_dCv - real(pReal) :: & - VoidPhaseFrac, kBT, KPot, dKPot_dCv - integer(pInt) :: & - homog, o - - homog = mappingHomogenization(2,ip,el) - VoidPhaseFrac = porosity(homog)%p(porosityMapping(homog)%p(ip,el)) - kBT = vacancyflux_cahnhilliard_getEntropicCoeff(ip,el) - - ChemPot = vacancyflux_cahnhilliard_getFormationEnergy(ip,el) - dChemPot_dCv = 0.0_pReal - do o = 1_pInt, vacancyPolyOrder - ChemPot = ChemPot + kBT*((2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ & - real(2_pInt*o-1_pInt,pReal) - dChemPot_dCv = dChemPot_dCv + 2.0_pReal*kBT*(2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal) - enddo - - ChemPot = VoidPhaseFrac*VoidPhaseFrac*ChemPot & - - 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac) - - dChemPot_dCv = VoidPhaseFrac*VoidPhaseFrac*dChemPot_dCv & - + 2.0_pReal*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac) - - call vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el) - ChemPot = ChemPot + KPot - dChemPot_dCv = dChemPot_dCv + dKPot_dCv - - if (Cv < 0.0_pReal) then - ChemPot = ChemPot - 3.0_pReal*vacancyBoundPenalty*Cv*Cv - dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*Cv - elseif (Cv > 1.0_pReal) then - ChemPot = ChemPot + 3.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv)*(1.0_pReal - Cv) - dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv) - endif - - ChemPot = ChemPot* & - vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el)) - dChemPot_dCv = dChemPot_dCv* & - vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el)) - -end subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief updated vacancy concentration and its rate with solution from transport PDE -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate(Cv,Cvdot,ip,el) - use material, only: & - mappingHomogenization, & - vacancyConc, & - vacancyConcRate, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv, & - Cvdot - integer(pInt) :: & - homog, & - offset - - homog = mappingHomogenization(2,ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - vacancyConc (homog)%p(offset) = Cv - vacancyConcRate(homog)%p(offset) = Cvdot - -end subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of vacancy transport results -!-------------------------------------------------------------------------------------------------- -function vacancyflux_cahnhilliard_postResults(ip,el) - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - vacancyConc, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(vacancyflux_cahnhilliard_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: & - vacancyflux_cahnhilliard_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - instance = vacancyflux_typeInstance(homog) - - c = 0_pInt - vacancyflux_cahnhilliard_postResults = 0.0_pReal - - do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance) - select case(vacancyflux_cahnhilliard_outputID(o,instance)) - - case (vacancyConc_ID) - vacancyflux_cahnhilliard_postResults(c+1_pInt) = vacancyConc(homog)%p(offset) - c = c + 1 - end select - enddo -end function vacancyflux_cahnhilliard_postResults - -end module vacancyflux_cahnhilliard diff --git a/code/vacancyflux_isochempot.f90 b/code/vacancyflux_isochempot.f90 deleted file mode 100644 index 35db8d159..000000000 --- a/code/vacancyflux_isochempot.f90 +++ /dev/null @@ -1,329 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for locally evolving vacancy concentration -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module vacancyflux_isochempot - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - vacancyflux_isochempot_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - vacancyflux_isochempot_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - vacancyflux_isochempot_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - vacancyflux_isochempot_Noutput !< number of outputs per instance of this damage - - enum, bind(c) - enumerator :: undefined_ID, & - vacancyconc_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - vacancyflux_isochempot_outputID !< ID of each post result output - - - public :: & - vacancyflux_isochempot_init, & - vacancyflux_isochempot_updateState, & - vacancyflux_isochempot_getSourceAndItsTangent, & - vacancyflux_isochempot_postResults - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_isochempot_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: & - vacancyflux_type, & - vacancyflux_typeInstance, & - homogenization_Noutput, & - VACANCYFLUX_isochempot_label, & - VACANCYFLUX_isochempot_ID, & - material_homog, & - mappingHomogenization, & - vacancyfluxState, & - vacancyfluxMapping, & - vacancyConc, & - vacancyConcRate, & - vacancyflux_initialCv, & - 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)') ' <<<+- vacancyflux_'//VACANCYFLUX_isochempot_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - endif mainProcess - - maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_isochempot_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(vacancyflux_isochempot_sizePostResults(maxNinstance), source=0_pInt) - allocate(vacancyflux_isochempot_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(vacancyflux_isochempot_output (maxval(homogenization_Noutput),maxNinstance)) - vacancyflux_isochempot_output = '' - allocate(vacancyflux_isochempot_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(vacancyflux_isochempot_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 (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux 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 ('vacancyconc') - vacancyflux_isochempot_Noutput(instance) = vacancyflux_isochempot_Noutput(instance) + 1_pInt - vacancyflux_isochempot_outputID(vacancyflux_isochempot_Noutput(instance),instance) = vacancyconc_ID - vacancyflux_isochempot_output(vacancyflux_isochempot_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(vacancyflux_type) - if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then - NofMyHomog=count(material_homog==section) - instance = vacancyflux_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,vacancyflux_isochempot_Noutput(instance) - select case(vacancyflux_isochempot_outputID(o,instance)) - case(vacancyconc_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - vacancyflux_isochempot_sizePostResult(o,instance) = mySize - vacancyflux_isochempot_sizePostResults(instance) = vacancyflux_isochempot_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 1_pInt - vacancyfluxState(section)%sizeState = sizeState - vacancyfluxState(section)%sizePostResults = vacancyflux_isochempot_sizePostResults(instance) - allocate(vacancyfluxState(section)%state0 (sizeState,NofMyHomog), source=vacancyflux_initialCv(section)) - allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog), source=vacancyflux_initialCv(section)) - allocate(vacancyfluxState(section)%state (sizeState,NofMyHomog), source=vacancyflux_initialCv(section)) - - nullify(vacancyfluxMapping(section)%p) - vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(vacancyConc(section)%p) - vacancyConc(section)%p => vacancyfluxState(section)%state(1,:) - deallocate(vacancyConcRate(section)%p) - allocate(vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal) - - endif - - enddo initializeInstances -end subroutine vacancyflux_isochempot_init - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates change in vacancy concentration based on local vacancy generation model -!-------------------------------------------------------------------------------------------------- -function vacancyflux_isochempot_updateState(subdt, ip, el) - use numerics, only: & - err_vacancyflux_tolAbs, & - err_vacancyflux_tolRel - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - vacancyfluxState, & - vacancyConc, & - vacancyConcRate, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - subdt - logical, dimension(2) :: & - vacancyflux_isochempot_updateState - integer(pInt) :: & - homog, & - offset, & - instance - real(pReal) :: & - Cv, Cvdot, dCvDot_dCv - - homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) - instance = vacancyflux_typeInstance(homog) - - Cv = vacancyfluxState(homog)%subState0(1,offset) - call vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el) - Cv = Cv + subdt*Cvdot - - vacancyflux_isochempot_updateState = [ abs(Cv - vacancyfluxState(homog)%state(1,offset)) & - <= err_vacancyflux_tolAbs & - .or. abs(Cv - vacancyfluxState(homog)%state(1,offset)) & - <= err_vacancyflux_tolRel*abs(vacancyfluxState(homog)%state(1,offset)), & - .true.] - - vacancyConc (homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = Cv - vacancyConcRate(homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = & - (vacancyfluxState(homog)%state(1,offset) - vacancyfluxState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal)) - -end function vacancyflux_isochempot_updateState - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates homogenized vacancy driving forces -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el) - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - phaseAt, phasememberAt, & - phase_source, & - phase_Nsources, & - SOURCE_vacancy_phenoplasticity_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID - use source_vacancy_phenoplasticity, only: & - source_vacancy_phenoplasticity_getRateAndItsTangent - use source_vacancy_irradiation, only: & - source_vacancy_irradiation_getRateAndItsTangent - use source_vacancy_thermalfluc, only: & - source_vacancy_thermalfluc_getRateAndItsTangent - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - integer(pInt) :: & - phase, & - grain, & - source - real(pReal) :: & - CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv - - CvDot = 0.0_pReal - dCvDot_dCv = 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_vacancy_phenoplasticity_ID) - call source_vacancy_phenoplasticity_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_irradiation_ID) - call source_vacancy_irradiation_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_thermalfluc_ID) - call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip, el) - - end select - CvDot = CvDot + localCvDot - dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv - enddo - enddo - - CvDot = CvDot/homogenization_Ngrains(mappingHomogenization(2,ip,el)) - dCvDot_dCv = dCvDot_dCv/homogenization_Ngrains(mappingHomogenization(2,ip,el)) - -end subroutine vacancyflux_isochempot_getSourceAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of vacancy transport results -!-------------------------------------------------------------------------------------------------- -function vacancyflux_isochempot_postResults(ip,el) - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - vacancyConc, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(vacancyflux_isochempot_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: & - vacancyflux_isochempot_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - instance = vacancyflux_typeInstance(homog) - - c = 0_pInt - vacancyflux_isochempot_postResults = 0.0_pReal - - do o = 1_pInt,vacancyflux_isochempot_Noutput(instance) - select case(vacancyflux_isochempot_outputID(o,instance)) - - case (vacancyconc_ID) - vacancyflux_isochempot_postResults(c+1_pInt) = vacancyConc(homog)%p(offset) - c = c + 1 - end select - enddo -end function vacancyflux_isochempot_postResults - -end module vacancyflux_isochempot diff --git a/code/vacancyflux_isoconc.f90 b/code/vacancyflux_isoconc.f90 deleted file mode 100644 index 63cfb1b62..000000000 --- a/code/vacancyflux_isoconc.f90 +++ /dev/null @@ -1,63 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -! $Id$ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for constant vacancy concentration -!-------------------------------------------------------------------------------------------------- -module vacancyflux_isoconc - - implicit none - private - - public :: & - vacancyflux_isoconc_init - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_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)') ' <<<+- vacancyflux_'//VACANCYFLUX_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 (vacancyflux_type(homog) == VACANCYFLUX_isoconc_ID) then - NofMyHomog = count(material_homog == homog) - vacancyfluxState(homog)%sizeState = 0_pInt - vacancyfluxState(homog)%sizePostResults = 0_pInt - allocate(vacancyfluxState(homog)%state0 (0_pInt,NofMyHomog)) - allocate(vacancyfluxState(homog)%subState0(0_pInt,NofMyHomog)) - allocate(vacancyfluxState(homog)%state (0_pInt,NofMyHomog)) - - deallocate(vacancyConc (homog)%p) - allocate (vacancyConc (homog)%p(1), source=vacancyflux_initialCv(homog)) - deallocate(vacancyConcRate(homog)%p) - allocate (vacancyConcRate(homog)%p(1), source=0.0_pReal) - - endif myhomog - enddo initializeInstances - - -end subroutine vacancyflux_isoconc_init - -end module vacancyflux_isoconc