223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

change code folder to src

This commit is contained in:
Chen Zhang 2016-03-04 14:43:29 -05:00
parent 005e4df0dd
commit e33594cb44
80 changed files with 55388 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

172
src/CMakeLists.txt Normal file
View File

@ -0,0 +1,172 @@
# The dependency detection in CMake is not functioning for Fortran
# !!! EXPLICIT DEPENDENCY DECLARATION !!!
add_library(DAMASK_PREC "prec.f90")
if (SPECTRAL)
add_library(DAMASK_INTERFACE "spectral_interface.f90")
elseif(FEM)
add_library(DAMASK_INTERFACE "DAMASK_FEM_interface.f90")
endif(SPECTRAL)
target_link_libraries(DAMASK_INTERFACE DAMASK_PREC)
add_library(DAMASK_IO "IO.f90")
target_link_libraries(DAMASK_IO DAMASK_INTERFACE)
add_library(DAMASK_LIBS "libs.f90")
target_link_libraries(DAMASK_LIBS DAMASK_IO)
add_library(DAMASK_NUMERICS "numerics.f90")
target_link_libraries(DAMASK_NUMERICS DAMASK_LIBS)
add_library(DAMASK_DEBUG "debug.f90")
target_link_libraries(DAMASK_DEBUG DAMASK_NUMERICS)
add_library(DAMASK_FEsolving "FEsolving.f90")
target_link_libraries(DAMASK_FEsolving DAMASK_DEBUG)
add_library(DAMASK_MATH "math.f90")
target_link_libraries(DAMASK_MATH DAMASK_FEsolving)
# SPECTRAL solver and FEM solver use different mesh
# source files
if (SPECTRAL)
add_library(DAMASK_MESH "mesh.f90")
target_link_libraries(DAMASK_MESH DAMASK_MATH)
endif(SPECTRAL)
if (FEM)
add_library(DAMASK_FEZoo "FEZoo.f90")
target_link_libraries(DAMASK_FEZoo DAMASK_MATH)
add_library(DAMASK_MESH "meshFEM.f90")
target_link_libraries(DAMASK_MESH DAMASK_FEZoo)
endif(FEM)
add_library(DAMASK_MATERIAL "material.f90")
target_link_libraries(DAMASK_MATERIAL DAMASK_MESH)
add_library(DAMASK_LATTICE "lattice.f90")
target_link_libraries(DAMASK_LATTICE DAMASK_MATERIAL)
add_library(DAMASK_DRIVERS ALIAS DAMASK_LATTICE)
# For each modular section
add_library (DAMASK_PLASTIC "plastic_dislotwin.f90"
"plastic_disloUCLA.f90"
"plastic_isotropic.f90"
"plastic_j2.f90"
"plastic_phenopowerlaw.f90"
"plastic_titanmod.f90"
"plastic_nonlocal.f90"
"plastic_none.f90"
"plastic_phenoplus.f90")
target_link_libraries(DAMASK_PLASTIC DAMASK_DRIVERS)
add_library (DAMASK_KINEMATICS "kinematics_cleavage_opening.f90"
"kinematics_slipplane_opening.f90"
"kinematics_thermal_expansion.f90"
"kinematics_vacancy_strain.f90"
"kinematics_hydrogen_strain.f90")
target_link_libraries(DAMASK_KINEMATICS DAMASK_DRIVERS)
add_library (DAMASK_SOURCE "source_thermal_dissipation.f90"
"source_thermal_externalheat.f90"
"source_damage_isoBrittle.f90"
"source_damage_isoDuctile.f90"
"source_damage_anisoBrittle.f90"
"source_damage_anisoDuctile.f90"
"source_vacancy_phenoplasticity.f90"
"source_vacancy_irradiation.f90"
"source_vacancy_thermalfluc.f90")
target_link_libraries(DAMASK_SOURCE DAMASK_DRIVERS)
add_library(DAMASK_CONSTITUTIVE "constitutive.f90")
target_link_libraries(DAMASK_CONSTITUTIVE DAMASK_PLASTIC )
target_link_libraries(DAMASK_CONSTITUTIVE DAMASK_KINEMATICS)
target_link_libraries(DAMASK_CONSTITUTIVE DAMASK_SOURCE )
add_library(DAMASK_CRYSTALLITE "crystallite.f90")
target_link_libraries(DAMASK_CRYSTALLITE DAMASK_CONSTITUTIVE)
add_library(DAMASK_HOMOGENIZATION "homogenization_RGC.f90"
"homogenization_isostrain.f90"
"homogenization_none.f90")
target_link_libraries(DAMASK_HOMOGENIZATION DAMASK_CRYSTALLITE)
add_library(DAMASK_HYDROGENFLUX "hydrogenflux_isoconc.f90"
"hydrogenflux_cahnhilliard.f90")
target_link_libraries(DAMASK_HYDROGENFLUX DAMASK_CRYSTALLITE)
add_library(DAMASK_POROSITY "porosity_none.f90"
"porosity_phasefield.f90")
target_link_libraries(DAMASK_POROSITY DAMASK_CRYSTALLITE)
add_library(DAMASK_VACANCYFLUX "vacancyflux_isoconc.f90"
"vacancyflux_isochempot.f90"
"vacancyflux_cahnhilliard.f90")
target_link_libraries(DAMASK_VACANCYFLUX DAMASK_CRYSTALLITE)
add_library(DAMASK_DAMAGE "damage_none.f90"
"damage_local.f90"
"damage_nonlocal.f90")
target_link_libraries(DAMASK_DAMAGE DAMASK_CRYSTALLITE)
add_library(DAMASK_THERMAL "thermal_isothermal.f90"
"thermal_adiabatic.f90"
"thermal_conduction.f90")
target_link_libraries(DAMASK_THERMAL DAMASK_CRYSTALLITE)
add_library(DAMASK_ENGINE "homogenization.f90")
target_link_libraries(DAMASK_ENGINE DAMASK_THERMAL )
target_link_libraries(DAMASK_ENGINE DAMASK_DAMAGE )
target_link_libraries(DAMASK_ENGINE DAMASK_VACANCYFLUX )
target_link_libraries(DAMASK_ENGINE DAMASK_POROSITY )
target_link_libraries(DAMASK_ENGINE DAMASK_HYDROGENFLUX )
target_link_libraries(DAMASK_ENGINE DAMASK_HOMOGENIZATION)
if (FEM)
add_library(DAMASK_CPFE "CPFEM.f90")
target_link_libraries(DAMASK_CPFE DAMASK_ENGINE)
add_library(DAMASK_FEM_UTILITY "FEM_utilities.f90")
target_link_libraries(DAMASK_FEM_UTILITY DAMASK_CPFE)
add_library(DAMASK_FEM_BASE "FEM_hydrogenflux.f90"
"FEM_porosity.f90"
"FEM_vacancyflux.f90"
"FEM_damage.f90"
"FEM_thermal.f90"
"FEM_mech.f90")
target_link_libraries(DAMASK_FEM_BASE DAMASK_FEM_UTILITY)
add_library(DAMASK_FEM_DRIVER "DAMASK_FEM_driver.f90")
target_link_libraries(DAMASK_FEM_DRIVER DAMASK_FEM_BASE)
add_executable(DAMASK_FEM.exe "DAMASK_FEM_driver.f90")
target_link_libraries(DAMASK_FEM.exe DAMASK_FEM_DRIVER)
endif(FEM)
if (SPECTRAL)
add_library(DAMASK_CPFE "CPFEM2.f90")
target_link_libraries(DAMASK_CPFE DAMASK_ENGINE)
add_library(DAMASK_SPECTRAL_UTILITY spectral_utilities.f90)
target_link_libraries(DAMASK_SPECTRAL_UTILITY DAMASK_CPFE)
add_library(DAMASK_SPECTRAL_BASE "spectral_thermal.f90"
"spectral_damage.f90")
target_link_libraries(DAMASK_SPECTRAL_BASE DAMASK_SPECTRAL_UTILITY)
add_library(DAMASK_SPECTRAL_MECH "spectral_mech_AL.f90"
"spectral_mech_Polarisation.f90"
"spectral_mech_Basic.f90")
target_link_libraries(DAMASK_SPECTRAL_MECH DAMASK_SPECTRAL_UTILITY)
add_library(DAMASK_EXE "DAMASK_spectral.f90")
target_link_libraries(DAMASK_EXE DAMASK_CPFE )
target_link_libraries(DAMASK_EXE DAMASK_SPECTRAL_BASE)
target_link_libraries(DAMASK_EXE DAMASK_SPECTRAL_MECH)
add_executable(DAMASKSpectral.exe "DAMASK_spectral.f90")
target_link_libraries(DAMASKSpectral.exe DAMASK_EXE)
endif(SPECTRAL)

705
src/CPFEM.f90 Normal file
View File

@ -0,0 +1,705 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief CPFEM engine
!--------------------------------------------------------------------------------------------------
module CPFEM
use prec, only: &
pReal, &
pInt
implicit none
private
#if defined(Marc4DAMASK) || defined(Abaqus)
real(pReal), parameter, private :: &
CPFEM_odd_stress = 1e15_pReal, & !< return value for stress in case of ping pong dummy cycle
CPFEM_odd_jacobian = 1e50_pReal !< return value for jacobian in case of ping pong dummy cycle
real(pReal), dimension (:,:,:), allocatable, private :: &
CPFEM_cs !< Cauchy stress
real(pReal), dimension (:,:,:,:), allocatable, private :: &
CPFEM_dcsdE !< Cauchy stress tangent
real(pReal), dimension (:,:,:,:), allocatable, private :: &
CPFEM_dcsdE_knownGood !< known good tangent
#endif
integer(pInt), public :: &
cycleCounter = 0_pInt, & !< needs description
theInc = -1_pInt, & !< needs description
lastLovl = 0_pInt, & !< lovl in previous call to marc hypela2
lastStep = 0_pInt !< kstep in previous call to abaqus umat
real(pReal), public :: &
theTime = 0.0_pReal, & !< needs description
theDelta = 0.0_pReal
logical, public :: &
outdatedFFN1 = .false., & !< needs description
lastIncConverged = .false., & !< needs description
outdatedByNewInc = .false. !< needs description
logical, public, protected :: &
CPFEM_init_done = .false. !< remember whether init has been done already
logical, private :: &
CPFEM_calc_done = .false. !< remember whether first ip has already calced the results
integer(pInt), parameter, public :: &
CPFEM_COLLECT = 2_pInt**0_pInt, &
CPFEM_CALCRESULTS = 2_pInt**1_pInt, &
CPFEM_AGERESULTS = 2_pInt**2_pInt, &
CPFEM_BACKUPJACOBIAN = 2_pInt**3_pInt, &
CPFEM_RESTOREJACOBIAN = 2_pInt**4_pInt
public :: &
CPFEM_general, &
CPFEM_initAll
contains
!--------------------------------------------------------------------------------------------------
!> @brief call (thread safe) all module initializations
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll(el,ip)
use prec, only: &
prec_init
use numerics, only: &
numerics_init
use debug, only: &
debug_init
use FEsolving, only: &
FE_init
use math, only: &
math_init
use mesh, only: &
mesh_init
use lattice, only: &
lattice_init
use material, only: &
material_init
use constitutive, only: &
constitutive_init
use crystallite, only: &
crystallite_init
use homogenization, only: &
homogenization_init
use IO, only: &
IO_init
use DAMASK_interface
#ifdef FEM
use FEZoo, only: &
FEZoo_init
#endif
implicit none
integer(pInt), intent(in) :: el, & !< FE el number
ip !< FE integration point number
!$OMP CRITICAL (init)
if (.not. CPFEM_init_done) then
call DAMASK_interface_init ! Spectral and FEM interface to commandline
call prec_init
call IO_init
#ifdef FEM
call FEZoo_init
#endif
call numerics_init
call debug_init
call math_init
call FE_init
call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip
call lattice_init
call material_init
call constitutive_init
call crystallite_init
call homogenization_init
call CPFEM_init
CPFEM_init_done = .true.
endif
!$OMP END CRITICAL (init)
end subroutine CPFEM_initAll
!--------------------------------------------------------------------------------------------------
!> @brief allocate the arrays defined in module CPFEM and initialize them
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_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_read_realFile,&
IO_read_intFile, &
IO_timeStamp, &
IO_error
use numerics, only: &
worldrank
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive
use FEsolving, only: &
#if defined(Marc4DAMASK) || defined(Abaqus)
symmetricSolver, &
#endif
restartRead, &
modelName
#if defined(Marc4DAMASK) || defined(Abaqus)
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
#endif
use material, only: &
material_phase, &
homogState, &
phase_plasticity, &
plasticState, &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
crystallite_Fp0, &
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_dPdF0, &
crystallite_Tstar0_v
implicit none
integer(pInt) :: k,l,m,ph,homog
character(len=1024) :: rankStr
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
#if defined(Marc4DAMASK) || defined(Abaqus)
! initialize stress and jacobian to zero
allocate(CPFEM_cs(6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_cs = 0.0_pReal
allocate(CPFEM_dcsdE(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE = 0.0_pReal
allocate(CPFEM_dcsdE_knownGood(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE_knownGood = 0.0_pReal
#endif
! *** restore the last converged values of each essential variable from the binary file
if (restartRead) then
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then
write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files'
flush(6)
endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase))
read (777,rec=1) material_phase
close (777)
call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0))
read (777,rec=1) crystallite_F0
close (777)
call IO_read_realFile(777,'convergedFp'//trim(rankStr),modelName,size(crystallite_Fp0))
read (777,rec=1) crystallite_Fp0
close (777)
call IO_read_realFile(777,'convergedFi'//trim(rankStr),modelName,size(crystallite_Fi0))
read (777,rec=1) crystallite_Fi0
close (777)
call IO_read_realFile(777,'convergedLp'//trim(rankStr),modelName,size(crystallite_Lp0))
read (777,rec=1) crystallite_Lp0
close (777)
call IO_read_realFile(777,'convergedLi'//trim(rankStr),modelName,size(crystallite_Li0))
read (777,rec=1) crystallite_Li0
close (777)
call IO_read_realFile(777,'convergeddPdF'//trim(rankStr),modelName,size(crystallite_dPdF0))
read (777,rec=1) crystallite_dPdF0
close (777)
call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v))
read (777,rec=1) crystallite_Tstar0_v
close (777)
call IO_read_realFile(777,'convergedStateConst'//trim(rankStr),modelName)
m = 0_pInt
readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState
do l = 1, size(plasticState(ph)%state0(1,:))
m = m+1_pInt
read(777,rec=m) plasticState(ph)%state0(k,l)
enddo; enddo
enddo readPlasticityInstances
close (777)
call IO_read_realFile(777,'convergedStateHomog'//trim(rankStr),modelName)
m = 0_pInt
readHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState
do l = 1, size(homogState(homog)%state0(1,:))
m = m+1_pInt
read(777,rec=m) homogState(homog)%state0(k,l)
enddo; enddo
enddo readHomogInstances
close (777)
#if defined(Marc4DAMASK) || defined(Abaqus)
call IO_read_realFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE))
read (777,rec=1) CPFEM_dcsdE
close (777)
#endif
restartRead = .false.
endif
#if defined(Marc4DAMASK) || defined(Abaqus)
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE)
write(6,'(a32,1x,6(i8,1x),/)') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood)
write(6,'(a32,l1)') 'symmetricSolver: ', symmetricSolver
endif
#endif
flush(6)
end subroutine CPFEM_init
!--------------------------------------------------------------------------------------------------
!> @brief perform initialization at first call, update variables and call the actual material model
!--------------------------------------------------------------------------------------------------
#if defined(Marc4DAMASK) || defined(Abaqus)
subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyStress, jacobian)
#else
subroutine CPFEM_general(mode, ffn, ffn1, dt, elFE, ip)
#endif
use numerics, only: &
defgradTolerance, &
iJacoStiffness, &
worldrank
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective, &
#if defined(Marc4DAMASK) || defined(Abaqus)
debug_stressMaxLocation, &
debug_stressMinLocation, &
debug_jacobianMaxLocation, &
debug_jacobianMinLocation, &
debug_stressMax, &
debug_stressMin, &
debug_jacobianMax, &
debug_jacobianMin, &
#endif
debug_e, &
debug_i
use FEsolving, only: &
terminallyIll, &
FEsolving_execElem, &
FEsolving_execIP, &
restartWrite
use math, only: &
math_identity2nd, &
math_mul33x33, &
math_det33, &
math_transpose33, &
math_I3, &
math_Mandel3333to66, &
math_Mandel66to3333, &
math_Mandel33to6, &
math_Mandel6to33
use mesh, only: &
mesh_FEasCP, &
mesh_NcpElems, &
mesh_maxNips, &
mesh_element
use material, only: &
microstructure_elemhomo, &
plasticState, &
sourceState, &
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
hydrogenfluxState, &
phaseAt, phasememberAt, &
material_phase, &
phase_plasticity, &
temperature, &
thermalMapping, &
phase_Nsources, &
material_homog, &
material_Nhomogenization
use crystallite, only: &
crystallite_partionedF,&
crystallite_F0, &
crystallite_Fp0, &
crystallite_Fp, &
crystallite_Fi0, &
crystallite_Fi, &
crystallite_Lp0, &
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF0, &
crystallite_dPdF, &
crystallite_Tstar0_v, &
crystallite_Tstar_v
use homogenization, only: &
materialpoint_F, &
materialpoint_F0, &
#if defined(Marc4DAMASK) || defined(Abaqus)
materialpoint_P, &
materialpoint_dPdF, &
materialpoint_results, &
materialpoint_sizeResults, &
#endif
materialpoint_stressAndItsTangent, &
materialpoint_postResults
use IO, only: &
IO_write_jobRealFile, &
IO_warning
use DAMASK_interface
implicit none
integer(pInt), intent(in) :: elFE, & !< FE element number
ip !< integration point number
real(pReal), intent(in) :: dt !< time increment
real(pReal), dimension (3,3), intent(in) :: ffn, & !< deformation gradient for t=t0
ffn1 !< deformation gradient for t=t1
integer(pInt), intent(in) :: mode !< computation mode 1: regular computation plus aging of results
#if defined(Marc4DAMASK) || defined(Abaqus)
real(pReal), intent(in) :: temperature_inp !< temperature
logical, intent(in) :: parallelExecution !< flag indicating parallel computation of requested IPs
real(pReal), dimension(6), intent(out) :: cauchyStress !< stress vector in Mandel notation
real(pReal), dimension(6,6), intent(out) :: jacobian !< jacobian in Mandel notation (Consistent tangent dcs/dE)
real(pReal) J_inverse, & ! inverse of Jacobian
rnd
real(pReal), dimension (3,3) :: Kirchhoff, & ! Piola-Kirchhoff stress in Matrix notation
cauchyStress33 ! stress vector in Matrix notation
real(pReal), dimension (3,3,3,3) :: H_sym, &
H, &
jacobian3333 ! jacobian in Matrix notation
#else
logical, parameter :: parallelExecution = .true.
#endif
integer(pInt) elCP, & ! crystal plasticity element number
i, j, k, l, m, n, ph, homog, mySource
logical updateJaco ! flag indicating if JAcobian has to be updated
character(len=1024) :: rankStr
#if defined(Marc4DAMASK) || defined(Abaqus)
elCP = mesh_FEasCP('elem',elFE)
#else
elCP = elFE
#endif
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt &
.and. elCP == debug_e .and. ip == debug_i) then
write(6,'(/,a)') '#############################################'
write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#'
write(6,'(a1,a22,1x,f15.7,a6)') '#','theTime', theTime, '#'
write(6,'(a1,a22,1x,f15.7,a6)') '#','theDelta', theDelta, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','theInc', theInc, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','cycleCounter', cycleCounter, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','computationMode',mode, '#'
if (terminallyIll) &
write(6,'(a,/)') '# --- terminallyIll --- #'
write(6,'(a,/)') '#############################################'; flush (6)
endif
#if defined(Marc4DAMASK) || defined(Abaqus)
if (iand(mode, CPFEM_BACKUPJACOBIAN) /= 0_pInt) &
CPFEM_dcsde_knownGood = CPFEM_dcsde
if (iand(mode, CPFEM_RESTOREJACOBIAN) /= 0_pInt) &
CPFEM_dcsde = CPFEM_dcsde_knownGood
#endif
!*** age results and write restart data if requested
if (iand(mode, CPFEM_AGERESULTS) /= 0_pInt) then
crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...)
crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation
crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity
crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation
crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity
crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness
crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress
forall ( i = 1:size(plasticState )) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array
do i = 1, size(sourceState)
do mySource = 1,phase_Nsources(i)
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array
enddo; enddo
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
write(6,'(a)') '<< CPFEM >> aging states'
if (debug_e <= mesh_NcpElems .and. debug_i <= mesh_maxNips) then
write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') &
'<< CPFEM >> aged state of elFE ip grain',debug_e, debug_i, 1, &
plasticState(phaseAt(1,debug_i,debug_e))%state(:,phasememberAt(1,debug_i,debug_e))
endif
endif
do homog = 1_pInt, material_Nhomogenization
homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state
damageState (homog)%state0 = damageState (homog)%state
vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state
hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state
enddo
! * dump the last converged values of each essential variable to a binary file
if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files'
write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase))
write (777,rec=1) material_phase
close (777)
call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0))
write (777,rec=1) crystallite_F0
close (777)
call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0))
write (777,rec=1) crystallite_Fp0
close (777)
call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0))
write (777,rec=1) crystallite_Fi0
close (777)
call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0))
write (777,rec=1) crystallite_Lp0
close (777)
call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0))
write (777,rec=1) crystallite_Li0
close (777)
call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0))
write (777,rec=1) crystallite_dPdF0
close (777)
call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v))
write (777,rec=1) crystallite_Tstar0_v
close (777)
call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr))
m = 0_pInt
writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState
do l = 1, size(plasticState(ph)%state0(1,:))
m = m+1_pInt
write(777,rec=m) plasticState(ph)%state0(k,l)
enddo; enddo
enddo writePlasticityInstances
close (777)
call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr))
m = 0_pInt
writeHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState
do l = 1, size(homogState(homog)%state0(1,:))
m = m+1_pInt
write(777,rec=m) homogState(homog)%state0(k,l)
enddo; enddo
enddo writeHomogInstances
close (777)
#if defined(Marc4DAMASK) || defined(Abaqus)
call IO_write_jobRealFile(777,'convergeddcsdE',size(CPFEM_dcsdE))
write (777,rec=1) CPFEM_dcsdE
close (777)
#endif
endif
endif ! results aging
!*** collection of FEM input with returning of randomize odd stress and jacobian
!* If no parallel execution is required, there is no need to collect FEM input
if (.not. parallelExecution) then
#if defined(Marc4DAMASK) || defined(Abaqus)
temperature(material_homog(ip,elCP))%p(thermalMapping(material_homog(ip,elCP))%p(ip,elCP)) = &
temperature_inp
#endif
materialpoint_F0(1:3,1:3,ip,elCP) = ffn
materialpoint_F(1:3,1:3,ip,elCP) = ffn1
elseif (iand(mode, CPFEM_COLLECT) /= 0_pInt) then
#if defined(Marc4DAMASK) || defined(Abaqus)
call random_number(rnd)
if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
CPFEM_cs(1:6,ip,elCP) = rnd * CPFEM_odd_stress
CPFEM_dcsde(1:6,1:6,ip,elCP) = CPFEM_odd_jacobian * math_identity2nd(6)
temperature(material_homog(ip,elCP))%p(thermalMapping(material_homog(ip,elCP))%p(ip,elCP)) = &
temperature_inp
#endif
materialpoint_F0(1:3,1:3,ip,elCP) = ffn
materialpoint_F(1:3,1:3,ip,elCP) = ffn1
CPFEM_calc_done = .false.
endif ! collection
!*** calculation of stress and jacobian
if (iand(mode, CPFEM_CALCRESULTS) /= 0_pInt) then
!*** deformation gradient outdated or any actual deformation gradient differs more than relevantStrain from the stored one
validCalculation: if (terminallyIll &
.or. outdatedFFN1 &
.or. any(abs(ffn1 - materialpoint_F(1:3,1:3,ip,elCP)) > defgradTolerance)) then
if (any(abs(ffn1 - materialpoint_F(1:3,1:3,ip,elCP)) > defgradTolerance)) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
write(6,'(a,1x,i8,1x,i2)') '<< CPFEM >> OUTDATED at elFE ip',elFE,ip
write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 old:',&
math_transpose33(materialpoint_F(1:3,1:3,ip,elCP))
write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 now:',math_transpose33(ffn1)
endif
outdatedFFN1 = .true.
endif
#if defined(Marc4DAMASK) || defined(Abaqus)
call random_number(rnd)
if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
CPFEM_cs(1:6,ip,elCP) = rnd*CPFEM_odd_stress
CPFEM_dcsde(1:6,1:6,ip,elCP) = CPFEM_odd_jacobian*math_identity2nd(6)
#endif
!*** deformation gradient is not outdated
else validCalculation
updateJaco = mod(cycleCounter,iJacoStiffness) == 0
!* no parallel computation, so we use just one single elFE and ip for computation
if (.not. parallelExecution) then
FEsolving_execElem(1) = elCP
FEsolving_execElem(2) = elCP
if (.not. microstructure_elemhomo(mesh_element(4,elCP)) .or. & ! calculate unless homogeneous
(microstructure_elemhomo(mesh_element(4,elCP)) .and. ip == 1_pInt)) then ! and then only first ip
FEsolving_execIP(1,elCP) = ip
FEsolving_execIP(2,elCP) = ip
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip
call materialpoint_stressAndItsTangent(updateJaco, dt) ! calculate stress and its tangent
call materialpoint_postResults()
endif
!* parallel computation and calulation not yet done
elseif (.not. CPFEM_calc_done) then
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
write(6,'(a,i8,a,i8)') '<< CPFEM >> calculation for elements ',FEsolving_execElem(1),&
' to ',FEsolving_execElem(2)
call materialpoint_stressAndItsTangent(updateJaco, dt) ! calculate stress and its tangent (parallel execution inside)
call materialpoint_postResults()
CPFEM_calc_done = .true.
endif
!* map stress and stiffness (or return odd values if terminally ill)
#if defined(Marc4DAMASK) || defined(Abaqus)
terminalIllness: if ( terminallyIll ) then
call random_number(rnd)
if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
CPFEM_cs(1:6,ip,elCP) = rnd * CPFEM_odd_stress
CPFEM_dcsde(1:6,1:6,ip,elCP) = CPFEM_odd_jacobian * math_identity2nd(6)
else terminalIllness
if (microstructure_elemhomo(mesh_element(4,elCP)) .and. ip > 1_pInt) then ! me homogenous? --> copy from first ip
materialpoint_P(1:3,1:3,ip,elCP) = materialpoint_P(1:3,1:3,1,elCP)
materialpoint_F(1:3,1:3,ip,elCP) = materialpoint_F(1:3,1:3,1,elCP)
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,elCP) = materialpoint_dPdF(1:3,1:3,1:3,1:3,1,elCP)
materialpoint_results(1:materialpoint_sizeResults,ip,elCP) = &
materialpoint_results(1:materialpoint_sizeResults,1,elCP)
endif
! translate from P to CS
Kirchhoff = math_mul33x33(materialpoint_P(1:3,1:3,ip,elCP), math_transpose33(materialpoint_F(1:3,1:3,ip,elCP)))
J_inverse = 1.0_pReal / math_det33(materialpoint_F(1:3,1:3,ip,elCP))
CPFEM_cs(1:6,ip,elCP) = math_Mandel33to6(J_inverse * Kirchhoff)
! translate from dP/dF to dCS/dE
H = 0.0_pReal
do i=1,3; do j=1,3; do k=1,3; do l=1,3; do m=1,3; do n=1,3
H(i,j,k,l) = H(i,j,k,l) + &
materialpoint_F(j,m,ip,elCP) * &
materialpoint_F(l,n,ip,elCP) * &
materialpoint_dPdF(i,m,k,n,ip,elCP) - &
math_I3(j,l) * materialpoint_F(i,m,ip,elCP) * materialpoint_P(k,m,ip,elCP) + &
0.5_pReal * (math_I3(i,k) * Kirchhoff(j,l) + math_I3(j,l) * Kirchhoff(i,k) + &
math_I3(i,l) * Kirchhoff(j,k) + math_I3(j,k) * Kirchhoff(i,l))
enddo; enddo; enddo; enddo; enddo; enddo
forall(i=1:3, j=1:3,k=1:3,l=1:3) &
H_sym(i,j,k,l) = 0.25_pReal * (H(i,j,k,l) + H(j,i,k,l) + H(i,j,l,k) + H(j,i,l,k))
CPFEM_dcsde(1:6,1:6,ip,elCP) = math_Mandel3333to66(J_inverse * H_sym)
endif terminalIllness
#endif
endif validCalculation
#if defined(Marc4DAMASK) || defined(Abaqus)
!* report stress and stiffness
if ((iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
.and. ((debug_e == elCP .and. debug_i == ip) &
.or. .not. iand(debug_level(debug_CPFEM), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') &
'<< CPFEM >> stress/MPa at elFE ip ', elFE, ip, CPFEM_cs(1:6,ip,elCP)*1.0e-6_pReal
write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') &
'<< CPFEM >> Jacobian/GPa at elFE ip ', elFE, ip, transpose(CPFEM_dcsdE(1:6,1:6,ip,elCP))*1.0e-9_pReal
flush(6)
endif
#endif
endif
#if defined(Marc4DAMASK) || defined(Abaqus)
!*** warn if stiffness close to zero
if (all(abs(CPFEM_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pReal)) call IO_warning(601,elCP,ip)
!*** copy to output if using commercial FEM solver
cauchyStress = CPFEM_cs (1:6, ip,elCP)
jacobian = CPFEM_dcsdE(1:6,1:6,ip,elCP)
!*** remember extreme values of stress ...
cauchyStress33 = math_Mandel6to33(CPFEM_cs(1:6,ip,elCP))
if (maxval(cauchyStress33) > debug_stressMax) then
debug_stressMaxLocation = [elCP, ip]
debug_stressMax = maxval(cauchyStress33)
endif
if (minval(cauchyStress33) < debug_stressMin) then
debug_stressMinLocation = [elCP, ip]
debug_stressMin = minval(cauchyStress33)
endif
!*** ... and Jacobian
jacobian3333 = math_Mandel66to3333(CPFEM_dcsdE(1:6,1:6,ip,elCP))
if (maxval(jacobian3333) > debug_jacobianMax) then
debug_jacobianMaxLocation = [elCP, ip]
debug_jacobianMax = maxval(jacobian3333)
endif
if (minval(jacobian3333) < debug_jacobianMin) then
debug_jacobianMinLocation = [elCP, ip]
debug_jacobianMin = minval(jacobian3333)
endif
#endif
end subroutine CPFEM_general
end module CPFEM

367
src/CPFEM2.f90 Normal file
View File

@ -0,0 +1,367 @@
!--------------------------------------------------------------------------------------------------
! $Id: CPFEM.f90 4761 2016-01-17 13:29:42Z MPIE\m.diehl $
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief needs a good name and description
!--------------------------------------------------------------------------------------------------
module CPFEM2
implicit none
private
public :: &
CPFEM_general, &
CPFEM_initAll
contains
!--------------------------------------------------------------------------------------------------
!> @brief call (thread safe) all module initializations
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll(el,ip)
use prec, only: &
pInt
use prec, only: &
prec_init
use numerics, only: &
numerics_init
use debug, only: &
debug_init
use FEsolving, only: &
FE_init
use math, only: &
math_init
use mesh, only: &
mesh_init
use lattice, only: &
lattice_init
use material, only: &
material_init
use constitutive, only: &
constitutive_init
use crystallite, only: &
crystallite_init
use homogenization, only: &
homogenization_init, &
materialpoint_postResults
use IO, only: &
IO_init
use DAMASK_interface
#ifdef FEM
use FEZoo, only: &
FEZoo_init
#endif
implicit none
integer(pInt), intent(in) :: el, & !< FE el number
ip !< FE integration point number
call DAMASK_interface_init ! Spectral and FEM interface to commandline
call prec_init
call IO_init
#ifdef FEM
call FEZoo_init
#endif
call numerics_init
call debug_init
call math_init
call FE_init
call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip
call lattice_init
call material_init
call constitutive_init
call crystallite_init
call homogenization_init
call materialpoint_postResults
call CPFEM_init
end subroutine CPFEM_initAll
!--------------------------------------------------------------------------------------------------
!> @brief allocate the arrays defined in module CPFEM and initialize them
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_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_read_realFile,&
IO_read_intFile, &
IO_timeStamp, &
IO_error
use numerics, only: &
worldrank
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive
use FEsolving, only: &
restartRead, &
modelName
use material, only: &
material_phase, &
homogState, &
phase_plasticity, &
plasticState, &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
crystallite_Fp0, &
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_dPdF0, &
crystallite_Tstar0_v
implicit none
integer(pInt) :: k,l,m,ph,homog
character(len=1024) :: rankStr
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
! *** restore the last converged values of each essential variable from the binary file
if (restartRead) then
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then
write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files'
flush(6)
endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase))
read (777,rec=1) material_phase
close (777)
call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0))
read (777,rec=1) crystallite_F0
close (777)
call IO_read_realFile(777,'convergedFp'//trim(rankStr),modelName,size(crystallite_Fp0))
read (777,rec=1) crystallite_Fp0
close (777)
call IO_read_realFile(777,'convergedFi'//trim(rankStr),modelName,size(crystallite_Fi0))
read (777,rec=1) crystallite_Fi0
close (777)
call IO_read_realFile(777,'convergedLp'//trim(rankStr),modelName,size(crystallite_Lp0))
read (777,rec=1) crystallite_Lp0
close (777)
call IO_read_realFile(777,'convergedLi'//trim(rankStr),modelName,size(crystallite_Li0))
read (777,rec=1) crystallite_Li0
close (777)
call IO_read_realFile(777,'convergeddPdF'//trim(rankStr),modelName,size(crystallite_dPdF0))
read (777,rec=1) crystallite_dPdF0
close (777)
call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v))
read (777,rec=1) crystallite_Tstar0_v
close (777)
call IO_read_realFile(777,'convergedStateConst'//trim(rankStr),modelName)
m = 0_pInt
readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState
do l = 1, size(plasticState(ph)%state0(1,:))
m = m+1_pInt
read(777,rec=m) plasticState(ph)%state0(k,l)
enddo; enddo
enddo readPlasticityInstances
close (777)
call IO_read_realFile(777,'convergedStateHomog'//trim(rankStr),modelName)
m = 0_pInt
readHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState
do l = 1, size(homogState(homog)%state0(1,:))
m = m+1_pInt
read(777,rec=m) homogState(homog)%state0(k,l)
enddo; enddo
enddo readHomogInstances
close (777)
restartRead = .false.
endif
flush(6)
end subroutine CPFEM_init
!--------------------------------------------------------------------------------------------------
!> @brief perform initialization at first call, update variables and call the actual material model
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_general(age, dt)
use prec, only: &
pReal, &
pInt
use numerics, only: &
worldrank
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective
use FEsolving, only: &
terminallyIll, &
restartWrite
use math, only: &
math_identity2nd, &
math_mul33x33, &
math_det33, &
math_transpose33, &
math_I3, &
math_Mandel3333to66, &
math_Mandel66to3333, &
math_Mandel33to6, &
math_Mandel6to33
use material, only: &
plasticState, &
sourceState, &
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
hydrogenfluxState, &
material_phase, &
phase_plasticity, &
phase_Nsources, &
material_Nhomogenization
use crystallite, only: &
crystallite_partionedF,&
crystallite_F0, &
crystallite_Fp0, &
crystallite_Fp, &
crystallite_Fi0, &
crystallite_Fi, &
crystallite_Lp0, &
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF0, &
crystallite_dPdF, &
crystallite_Tstar0_v, &
crystallite_Tstar_v
use homogenization, only: &
materialpoint_F, &
materialpoint_F0, &
materialpoint_stressAndItsTangent, &
materialpoint_postResults
use IO, only: &
IO_write_jobRealFile, &
IO_warning
use DAMASK_interface
implicit none
real(pReal), intent(in) :: dt !< time increment
logical, intent(in) :: age !< age results
integer(pInt) :: i, k, l, m, ph, homog, mySource
character(len=1024) :: rankStr
!*** age results and write restart data if requested
if (age) then
crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...)
crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation
crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity
crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation
crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity
crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness
crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress
forall ( i = 1:size(plasticState )) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array
do i = 1, size(sourceState)
do mySource = 1,phase_Nsources(i)
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array
enddo; enddo
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> aging states'
do homog = 1_pInt, material_Nhomogenization
homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state
damageState (homog)%state0 = damageState (homog)%state
vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state
hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state
enddo
if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files'
write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase))
write (777,rec=1) material_phase
close (777)
call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0))
write (777,rec=1) crystallite_F0
close (777)
call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0))
write (777,rec=1) crystallite_Fp0
close (777)
call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0))
write (777,rec=1) crystallite_Fi0
close (777)
call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0))
write (777,rec=1) crystallite_Lp0
close (777)
call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0))
write (777,rec=1) crystallite_Li0
close (777)
call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0))
write (777,rec=1) crystallite_dPdF0
close (777)
call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v))
write (777,rec=1) crystallite_Tstar0_v
close (777)
call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr))
m = 0_pInt
writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState
do l = 1, size(plasticState(ph)%state0(1,:))
m = m+1_pInt
write(777,rec=m) plasticState(ph)%state0(k,l)
enddo; enddo
enddo writePlasticityInstances
close (777)
call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr))
m = 0_pInt
writeHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState
do l = 1, size(homogState(homog)%state0(1,:))
m = m+1_pInt
write(777,rec=m) homogState(homog)%state0(k,l)
enddo; enddo
enddo writeHomogInstances
close (777)
endif
endif
if (.not. terminallyIll) &
call materialpoint_stressAndItsTangent(.True., dt)
end subroutine CPFEM_general
end module CPFEM2

299
src/DAMASK_abaqus_exp.f Normal file
View File

@ -0,0 +1,299 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Koen Janssens, Paul Scherrer Institut
!> @author Arun Prakash, Fraunhofer IWM
!> @brief interfaces DAMASK with Abaqus/Explicit
!> @details put the included file abaqus_v6.env in either your home or model directory,
!> it is a minimum Abaqus environment file containing all changes necessary to use the
!> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env)
!--------------------------------------------------------------------------------------------------
#ifndef INT
#define INT 4
#endif
#ifndef FLOAT
#define FLOAT 8
#endif
#define Abaqus
#include "prec.f90"
module DAMASK_interface
implicit none
character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp']
character(len=4), parameter :: LOGFILEEXTENSION = '.log'
contains
!--------------------------------------------------------------------------------------------------
!> @brief just reporting
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
integer, dimension(8) :: &
dateAndTime ! type default integer
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus_exp -+>>>'
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"
end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Explicit function to get working directory name
!--------------------------------------------------------------------------------------------------
character(1024) function getSolverWorkingDirectoryName()
implicit none
integer :: lenOutDir
getSolverWorkingDirectoryName=''
call vgetOutDir(getSolverWorkingDirectoryName, lenOutDir)
getSolverWorkingDirectoryName=trim(getSolverWorkingDirectoryName)//'/'
end function getSolverWorkingDirectoryName
!--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Explicit function to get solver job name
!--------------------------------------------------------------------------------------------------
character(1024) function getSolverJobName()
implicit none
integer :: lenJobName
getSolverJobName=''
call vGetJobName(getSolverJobName, lenJobName)
end function getSolverJobName
end module DAMASK_interface
#include "commercialFEM_fileList.f90"
subroutine vumat(nBlock, nDir, nshr, nStateV, nFieldV, nProps, lAnneal, &
stepTime, totalTime, dt, cmName, coordMp, charLength, &
props, density, strainInc, relSpinInc, &
tempOld, stretchOld, defgradOld, fieldOld, &
stressOld, stateOld, enerInternOld, enerInelasOld, &
tempNew, stretchNew, defgradNew, fieldNew, &
stressNew, stateNew, enerInternNew, enerInelasNew)
use prec, only: &
pReal, &
pInt
!$ use numerics, only: &
!$ DAMASK_NumThreadsInt
use FEsolving, only: &
symmetricSolver, &
terminallyIll
use math, only: &
invnrmMandel
use debug, only: &
debug_info, &
debug_reset, &
debug_levelBasic, &
debug_level, &
debug_abaqus
use mesh, only: &
mesh_unitlength, &
mesh_FEasCP, &
mesh_ipCoordinates
use CPFEM, only: &
CPFEM_general, &
CPFEM_init_done, &
CPFEM_initAll, &
CPFEM_CALCRESULTS, &
CPFEM_AGERESULTS, &
cycleCounter, &
theTime, &
outdatedByNewInc, &
outdatedFFN1
use homogenization, only: &
materialpoint_sizeResults, &
materialpoint_results
implicit none
integer(pInt), intent(in) :: &
nDir, & !< number of direct components in a symmetric tensor
nshr, & !< number of indirect components in a symmetric tensor
nStateV, & !< number of user-defined state variables that are associated with this material type
nFieldV, & !< number of user-defined external field variables
nprops, & !< user-specified number of user-defined material properties
lAnneal !< indicating whether the routine is being called during an annealing process
integer(pInt), dimension(*), intent(in) :: &
nBlock !< 1: No of Materialpoints in this call, 2: No of Materialpoint (IP)
!< 3: No of layer, 4: No of secPoint, 5+: element numbers
character(len=80), intent(in) :: &
cmname !< uses-specified material name, left justified
real(pReal), dimension(nprops), intent(in) :: &
props !< user-supplied material properties
real(pReal), intent(in) :: &
stepTime, & !< value of time since the step began
totalTime, & !< value of total time
dt !< time increment size
real(pReal), dimension(nblock(1)), intent(in) :: &
density, & !< current density at material points in the midstep configuration
charLength, & !< characteristic element length
enerInternOld, & !< internal energy per unit mass at each material point at the beginning of the increment
enerInelasOld, & !< dissipated inelastic energy per unit mass at each material point at the beginning of the increment
tempOld, & !< temperature at each material point at the beginning of the increment
tempNew !< temperature at each material point at the end of the increment (Temperature calculated in ABAQUS boundary conditions)
real(pReal), dimension(nblock(1),*), intent(in) :: &
coordMp !< material point coordinates
real(pReal), dimension(nblock(1),ndir+nshr), intent(in) :: &
strainInc, & !< strain increment tensor at each material point
stretchOld, & !< stretch tensor U at each material point
stretchNew, & !< stretch tensor U at each material point
stressOld !< stress tensor at each material point
real(pReal), dimension(nblock(1),nshr), intent(in) :: &
relSpinInc !< incremental relative rotation vector
real(pReal), dimension(nblock(1),nstatev), intent(in) :: &
stateOld !< state variables at each material point at the beginning of the increment
real(pReal), dimension(nblock(1),nfieldv), intent(in) :: &
fieldOld, & !< user-defined field variables
fieldNew !< user-defined field variables
real(pReal), dimension(nblock(1),ndir+2*nshr), intent(in) :: &
defgradOld, &
defgradNew
real(pReal), dimension(nblock(1)), intent(out) :: &
enerInternNew, & !< internal energy per unit mass at each material point at the end of the increment
enerInelasNew !< dissipated inelastic energy per unit mass at each material point at the end of the increment
real(pReal), dimension(nblock(1),ndir+nshr), intent(out) :: &
stressNew !< stress tensor at each material point at the end of the increment
real(pReal), dimension(nblock(1),nstatev), intent(out) :: &
stateNew !< state variables at each material point at the end of the increment
real(pReal), dimension(3) :: coordinates
real(pReal), dimension(3,3) :: defgrd0,defgrd1
real(pReal), dimension(6) :: stress
real(pReal), dimension(6,6) :: ddsdde
real(pReal) :: temp, timeInc, stresspower
integer(pInt) :: computationMode, n, i, cp_en
#ifdef _OPENMP
integer :: defaultNumThreadsInt !< default value set by Abaqus
include "omp_lib.h"
defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc
call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
#endif
computationMode = CPFEM_CALCRESULTS ! always calculate
do n = 1,nblock(1) ! loop over vector of IPs
temp = tempOld(n) ! temp is intent(in)
if ( .not. CPFEM_init_done ) then
call CPFEM_initAll(nBlock(4_pInt+n),nBlock(2))
outdatedByNewInc = .false.
if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
write(6,'(i8,1x,i2,1x,a)') nBlock(4_pInt+n),nBlock(2),'first call special case..!'; flush(6)
endif
else if (theTime < totalTime) then ! reached convergence
outdatedByNewInc = .true.
if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
write (6,'(i8,1x,i2,1x,a)') nBlock(4_pInt+n),nBlock(2),'lastIncConverged + outdated'; flush(6)
endif
endif
outdatedFFN1 = .false.
terminallyIll = .false.
cycleCounter = 1_pInt
if ( outdatedByNewInc ) then
outdatedByNewInc = .false.
call debug_info() ! first after new inc reports debugging
call debug_reset() ! resets debugging
computationMode = ior(computationMode, CPFEM_AGERESULTS) ! age results
endif
theTime = totalTime ! record current starting time
if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
write(6,'(a,i8,i2,a)') '(',nBlock(4_pInt+n),nBlock(2),')'; flush(6)
write(6,'(a,l1)') 'Aging Results: ', iand(computationMode, CPFEM_AGERESULTS) /= 0_pInt
endif
defgrd0 = 0.0_pReal
defgrd1 = 0.0_pReal
timeInc = dt
! ABAQUS explicit: deformation gradient as vector 11, 22, 33, 12, 23, 31, 21, 32, 13
! ABAQUS explicit: deformation gradient as vector 11, 22, 33, 12, 21
forall (i=1:ndir)
defgrd0(i,i) = defgradOld(n,i)
defgrd1(i,i) = defgradNew(n,i)
end forall
if (nshr == 1) then
defgrd0(1,2) = defgradOld(n,4)
defgrd1(1,2) = defgradNew(n,4)
defgrd0(2,1) = defgradOld(n,5)
defgrd1(2,1) = defgradNew(n,5)
else
defgrd0(1,2) = defgradOld(n,4)
defgrd1(1,2) = defgradNew(n,4)
defgrd0(1,3) = defgradOld(n,9)
defgrd1(1,3) = defgradNew(n,9)
defgrd0(2,1) = defgradOld(n,7)
defgrd1(2,1) = defgradNew(n,7)
defgrd0(2,3) = defgradOld(n,5)
defgrd1(2,3) = defgradNew(n,5)
defgrd0(3,1) = defgradOld(n,6)
defgrd1(3,1) = defgradNew(n,6)
defgrd0(3,2) = defgradOld(n,8)
defgrd1(3,2) = defgradNew(n,8)
endif
cp_en = mesh_FEasCP('elem',nBlock(4_pInt+n))
mesh_ipCoordinates(1:3,n,cp_en) = mesh_unitlength * coordMp(n,1:3)
call CPFEM_general(computationMode,.false.,defgrd0,defgrd1,temp,timeInc,cp_en,nBlock(2),stress,ddsdde)
! Mandel: 11, 22, 33, SQRT(2)*12, SQRT(2)*23, SQRT(2)*13
! straight: 11, 22, 33, 12, 23, 13
! ABAQUS implicit: 11, 22, 33, 12, 13, 23
! ABAQUS explicit: 11, 22, 33, 12, 23, 13
! ABAQUS explicit: 11, 22, 33, 12
stressNew(n,1:ndir+nshr) = stress(1:ndir+nshr)*invnrmMandel(1:ndir+nshr)
stateNew(n,1:min(nstatev,materialpoint_sizeResults)) = &
materialpoint_results(1:min(nstatev,materialpoint_sizeResults),&
nBlock(2),mesh_FEasCP('elem', nBlock(4_pInt+n)))
stresspower = 0.5_pReal*sum((stressOld(n,1:ndir)+stressNew(n,1:ndir))*straininc(n,1:ndir))+&
sum((stressOld(n,ndir+1:ndir+nshr)+stressNew(n,ndir+1:ndir+nshr))*straininc(n,ndir+1:ndir+nshr))
enerInternNew(n) = enerInternOld(n) + stresspower / density(n) ! Internal energy per unit mass
enerInelasNew(n) = enerInternNew(n) ! Dissipated inelastic energy per unit mass(Temporary output)
enddo
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
end subroutine vumat
!--------------------------------------------------------------------------------------------------
!> @brief calls the exit function of Abaqus/Explicit
!--------------------------------------------------------------------------------------------------
subroutine quit(mpie_error)
use prec, only: &
pInt
implicit none
integer(pInt) :: mpie_error
flush(6)
call xplb_exit
end subroutine quit

342
src/DAMASK_abaqus_std.f Normal file
View File

@ -0,0 +1,342 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Koen Janssens, Paul Scherrer Institut
!> @author Arun Prakash, Fraunhofer IWM
!> @brief interfaces DAMASK with Abaqus/Standard
!> @details put the included file abaqus_v6.env in either your home or model directory,
!> it is a minimum Abaqus environment file containing all changes necessary to use the
!> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env)
!--------------------------------------------------------------------------------------------------
#ifndef INT
#define INT 4
#endif
#ifndef FLOAT
#define FLOAT 8
#endif
#define Abaqus
#include "prec.f90"
module DAMASK_interface
implicit none
character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp']
character(len=4), parameter :: LOGFILEEXTENSION = '.log'
contains
!--------------------------------------------------------------------------------------------------
!> @brief just reporting
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
integer, dimension(8) :: &
dateAndTime ! type default integer
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>'
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"
end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Standard function to get working directory name
!--------------------------------------------------------------------------------------------------
character(1024) function getSolverWorkingDirectoryName()
implicit none
integer :: lenOutDir
getSolverWorkingDirectoryName=''
call getoutdir(getSolverWorkingDirectoryName, lenOutDir)
getSolverWorkingDirectoryName=trim(getSolverWorkingDirectoryName)//'/'
end function getSolverWorkingDirectoryName
!--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Standard function to get solver job name
!--------------------------------------------------------------------------------------------------
character(1024) function getSolverJobName()
implicit none
integer :: lenJobName
getSolverJobName=''
call getJobName(getSolverJobName, lenJobName)
end function getSolverJobName
end module DAMASK_interface
#include "commercialFEM_fileList.f90"
subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,&
TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,&
NSTATV,PROPS,NPROPS,COORDS,DROT,PNEWDT,CELENT,&
DFGRD0,DFGRD1,NOEL,NPT,KSLAY,KSPT,KSTEP,KINC)
use prec, only: &
pReal, &
pInt
use numerics, only: &
!$ DAMASK_NumThreadsInt, &
usePingPong
use FEsolving, only: &
calcMode, &
terminallyIll, &
symmetricSolver
use math, only: &
invnrmMandel
use debug, only: &
debug_info, &
debug_reset, &
debug_levelBasic, &
debug_level, &
debug_abaqus
use mesh, only: &
mesh_unitlength, &
mesh_FEasCP, &
mesh_ipCoordinates
use CPFEM, only: &
CPFEM_general, &
CPFEM_init_done, &
CPFEM_initAll, &
CPFEM_CALCRESULTS, &
CPFEM_AGERESULTS, &
CPFEM_COLLECT, &
CPFEM_RESTOREJACOBIAN, &
CPFEM_BACKUPJACOBIAN, &
cycleCounter, &
theInc, &
theTime, &
theDelta, &
lastIncConverged, &
outdatedByNewInc, &
outdatedFFN1, &
lastStep
use homogenization, only: &
materialpoint_sizeResults, &
materialpoint_results
implicit none
integer(pInt), intent(in) :: &
nDi, & !< Number of direct stress components at this point
nShr, & !< Number of engineering shear stress components at this point
nTens, & !< Size of the stress or strain component array (NDI + NSHR)
nStatV, & !< Number of solution-dependent state variables
nProps, & !< User-defined number of material constants
noEl, & !< element number
nPt,& !< integration point number
kSlay, & !< layer number (shell elements etc.)
kSpt, & !< section point within the current layer
kStep, & !< step number
kInc !< increment number
character(len=80), intent(in) :: &
cmname !< uses-specified material name, left justified
real(pReal), intent(in) :: &
DTIME, &
TEMP, &
DTEMP, &
CELENT
real(pReal), dimension(1), intent(in) :: &
PREDEF, &
DPRED
real(pReal), dimension(2), intent(in) :: &
TIME !< step time/total time at beginning of the current increment
real(pReal), dimension(3), intent(in) :: &
COORDS
real(pReal), dimension(nTens), intent(in) :: &
STRAN, & !< total strains at beginning of the increment
DSTRAN !< strain increments
real(pReal), dimension(nProps), intent(in) :: &
PROPS
real(pReal), dimension(3,3), intent(in) :: &
DROT, & !< rotation increment matrix
DFGRD0, & !< F at beginning of increment
DFGRD1 !< F at end of increment
real(pReal), intent(inout) :: &
PNEWDT, & !< ratio of suggested new time increment
SSE, & !< specific elastic strain engergy
SPD, & !< specific plastic dissipation
SCD, & !< specific creep dissipation
RPL, & !< volumetric heat generation per unit time at the end of the increment
DRPLDT !< varation of RPL with respect to the temperature
real(pReal), dimension(nTens), intent(inout) :: &
STRESS !< stress tensor at the beginning of the increment, needs to be updated
real(pReal), dimension(nStatV), intent(inout) :: &
STATEV !< solution-dependent state variables
real(pReal), dimension(nTens), intent(out) :: &
DDSDDT, &
DRPLDE
real(pReal), dimension(nTens,nTens), intent(out) :: &
DDSDDE !< Jacobian matrix of the constitutive model
real(pReal) :: temperature ! temp by Abaqus is intent(in)
real(pReal), dimension(6) :: stress_h
real(pReal), dimension(6,6) :: ddsdde_h
integer(pInt) :: computationMode, i, cp_en
logical :: cutBack
#ifdef _OPENMP
integer :: defaultNumThreadsInt !< default value set by Abaqus
include "omp_lib.h"
defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc
call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
#endif
temperature = temp ! temp is intent(in)
DDSDDT = 0.0_pReal
DRPLDE = 0.0_pReal
if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0 .and. noel == 1 .and. npt == 1) then
write(6,*) 'el',noel,'ip',npt
write(6,*) 'got kInc as',kInc
write(6,*) 'got dStran',dStran
flush(6)
endif
if (.not. CPFEM_init_done) call CPFEM_initAll(noel,npt)
computationMode = 0
cp_en = mesh_FEasCP('elem',noel)
if (time(2) > theTime .or. kInc /= theInc) then ! reached convergence
terminallyIll = .false.
cycleCounter = -1 ! first calc step increments this to cycle = 0
if (kInc == 1) then ! >> start of analysis <<
lastIncConverged = .false. ! no Jacobian backup
outdatedByNewInc = .false. ! no aging of state
calcMode = .false. ! pretend last step was collection
write (6,'(i8,1x,i2,1x,a)') noel,npt,'<< UMAT >> start of analysis..!';flush(6)
else if (kInc - theInc > 1) then ! >> restart of broken analysis <<
lastIncConverged = .false. ! no Jacobian backup
outdatedByNewInc = .false. ! no aging of state
calcMode = .true. ! pretend last step was calculation
write (6,'(i8,1x,i2,1x,a)') noel,npt,'<< UMAT >> restart of analysis..!';flush(6)
else ! >> just the next inc <<
lastIncConverged = .true. ! request Jacobian backup
outdatedByNewInc = .true. ! request aging of state
calcMode = .true. ! assure last step was calculation
write (6,'(i8,1x,i2,1x,a)') noel,npt,'<< UMAT >> new increment..!';flush(6)
endif
else if ( dtime < theDelta ) then ! >> cutBack <<
lastIncConverged = .false. ! no Jacobian backup
outdatedByNewInc = .false. ! no aging of state
terminallyIll = .false.
cycleCounter = -1 ! first calc step increments this to cycle = 0
calcMode = .true. ! pretend last step was calculation
write(6,'(i8,1x,i2,1x,a)') noel,npt,'<< UMAT >> cutback detected..!';flush(6)
endif ! convergence treatment end
if (usePingPong) then
calcMode(npt,cp_en) = .not. calcMode(npt,cp_en) ! ping pong (calc <--> collect)
if (calcMode(npt,cp_en)) then ! now --- CALC ---
computationMode = CPFEM_CALCRESULTS
if ( lastStep /= kStep ) then ! first after ping pong
call debug_reset() ! resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1_pInt
endif
if(outdatedByNewInc) then
computationMode = ior(computationMode,CPFEM_AGERESULTS) ! calc and age results
outdatedByNewInc = .false. ! reset flag
endif
else ! now --- COLLECT ---
computationMode = CPFEM_COLLECT ! plain collect
if(lastStep /= kStep .and. .not. terminallyIll) &
call debug_info() ! first after ping pong reports (meaningful) debugging
if (lastIncConverged) then
computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence
lastIncConverged = .false. ! reset flag
endif
mesh_ipCoordinates(1:3,npt,cp_en) = mesh_unitlength * COORDS
endif
else ! --- PLAIN MODE ---
computationMode = CPFEM_CALCRESULTS ! always calc
if (lastStep /= kStep) then
if (.not. terminallyIll) &
call debug_info() ! first reports (meaningful) debugging
call debug_reset() ! and resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1_pInt
endif
if (outdatedByNewInc) then
computationMode = ior(computationMode,CPFEM_AGERESULTS)
outdatedByNewInc = .false. ! reset flag
endif
if (lastIncConverged) then
computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! backup Jacobian after convergence
lastIncConverged = .false. ! reset flag
endif
endif
theTime = time(2) ! record current starting time
theDelta = dtime ! record current time increment
theInc = kInc ! record current increment number
lastStep = kStep ! record step number
if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
write(6,'(a16,1x,i2,1x,a,i8,a,i8,1x,i5,a)') 'computationMode',computationMode,'(',cp_en,':',noel,npt,')'
flush(6)
endif
call CPFEM_general(computationMode,usePingPong,dfgrd0,dfgrd1,temperature,dtime,noel,npt,stress_h,ddsdde_h)
! Mandel: 11, 22, 33, SQRT(2)*12, SQRT(2)*23, SQRT(2)*13
! straight: 11, 22, 33, 12, 23, 13
! ABAQUS explicit: 11, 22, 33, 12, 23, 13
! ABAQUS implicit: 11, 22, 33, 12, 13, 23
! ABAQUS implicit: 11, 22, 33, 12
forall(i=1:ntens) ddsdde(1:ntens,i) = invnrmMandel(i)*ddsdde_h(1:ntens,i)*invnrmMandel(1:ntens)
stress(1:ntens) = stress_h(1:ntens)*invnrmMandel(1:ntens)
if(symmetricSolver) ddsdde(1:ntens,1:ntens) = 0.5_pReal*(ddsdde(1:ntens,1:ntens) + transpose(ddsdde(1:ntens,1:ntens)))
if(ntens == 6) then
stress_h = stress
stress(5) = stress_h(6)
stress(6) = stress_h(5)
ddsdde_h = ddsdde
ddsdde(:,5) = ddsdde_h(:,6)
ddsdde(:,6) = ddsdde_h(:,5)
ddsdde_h = ddsdde
ddsdde(5,:) = ddsdde_h(6,:)
ddsdde(6,:) = ddsdde_h(5,:)
end if
statev = materialpoint_results(1:min(nstatv,materialpoint_sizeResults),npt,mesh_FEasCP('elem', noel))
if ( terminallyIll ) pnewdt = 0.5_pReal ! force cutback directly ?
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
end subroutine UMAT
!--------------------------------------------------------------------------------------------------
!> @brief calls the exit function of Abaqus/Standard
!--------------------------------------------------------------------------------------------------
subroutine quit(mpie_error)
use prec, only: &
pInt
implicit none
integer(pInt) :: mpie_error
flush(6)
call xit
end subroutine quit

426
src/DAMASK_marc.f90 Normal file
View File

@ -0,0 +1,426 @@
#define QUOTE(x) #x
#define PASTE(x,y) x ## y
#ifndef INT
#define INT 4
#endif
#ifndef FLOAT
#define FLOAT 8
#endif
#include "prec.f90"
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Luc Hantcherli, Max-Planck-Institut für Eisenforschung GmbH
!> @author W.A. Counts
!> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Material subroutine for MSC.Marc
!> @details Usage:
!> @details - choose material as hypela2
!> @details - set statevariable 2 to index of homogenization
!> @details - set statevariable 3 to index of microstructure
!> @details - make sure the file "material.config" exists in the working directory
!> @details - make sure the file "numerics.config" exists in the working directory
!> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!)
!> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric"
!> @details Marc subroutines used:
!> @details - hypela2
!> @details - plotv
!> @details - quit
!> @details Marc common blocks included:
!> @details - concom: lovl, inc
!> @details - creeps: timinc
!--------------------------------------------------------------------------------------------------
module DAMASK_interface
implicit none
character(len=4), parameter :: InputFileExtension = '.dat'
character(len=4), parameter :: LogFileExtension = '.log'
contains
!--------------------------------------------------------------------------------------------------
!> @brief only output of current version
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
implicit none
integer, dimension(8) :: &
dateAndTime ! type default integer
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>'
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"
end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief returns the current workingDir
!--------------------------------------------------------------------------------------------------
function getSolverWorkingDirectoryName()
implicit none
character(1024) getSolverWorkingDirectoryName, inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
getSolverWorkingDirectoryName=''
inputName=''
inquire(5, name=inputName) ! determine inputputfile
getSolverWorkingDirectoryName=inputName(1:scan(inputName,pathSep,back=.true.))
end function getSolverWorkingDirectoryName
!--------------------------------------------------------------------------------------------------
!> @brief solver job name (no extension) as combination of geometry and load case name
!--------------------------------------------------------------------------------------------------
function getSolverJobName()
use prec, only: &
pReal, &
pInt
implicit none
character(1024) :: getSolverJobName, inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
integer(pInt) :: extPos
getSolverJobName=''
inputName=''
inquire(5, name=inputName) ! determine inputfile
extPos = len_trim(inputName)-4
getSolverJobName=inputName(scan(inputName,pathSep,back=.true.)+1:extPos)
end function getSolverJobName
end module DAMASK_interface
#include "commercialFEM_fileList.f90"
!--------------------------------------------------------------------------------------------------
!> @brief This is the MSC.Marc user subroutine for defining material behavior
!> @details (1) F,R,U are only available for continuum and membrane elements (not for
!> @details shells and beams).
!> @details
!> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d)
!> @details in the parameter section of input deck (updated Lagrangian formulation).
!> @details
!> @details The following operation obtains U (stretch tensor) at t=n+1 :
!> @details
!> @details call scla(un1,0.d0,itel,itel,1)
!> @details do k=1,3
!> @details do i=1,3
!> @details do j=1,3
!> @details un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k)
!> @details enddo
!> @details enddo
!> @details enddo
!--------------------------------------------------------------------------------------------------
subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, &
strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
jtype,lclass,ifr,ifu)
use prec, only: &
pReal, &
pInt
use numerics, only: &
!$ DAMASK_NumThreadsInt, &
numerics_unitlength, &
usePingPong
use FEsolving, only: &
calcMode, &
terminallyIll, &
symmetricSolver
use math, only: &
math_transpose33,&
invnrmMandel
use debug, only: &
debug_level, &
debug_LEVELBASIC, &
debug_MARC, &
debug_info, &
debug_reset
use mesh, only: &
mesh_FEasCP, &
mesh_element, &
mesh_node0, &
mesh_node, &
mesh_Ncellnodes, &
mesh_cellnode, &
mesh_build_cellnodes, &
mesh_build_ipCoordinates, &
FE_Nnodes
use CPFEM, only: &
CPFEM_general, &
CPFEM_init_done, &
CPFEM_initAll, &
CPFEM_CALCRESULTS, &
CPFEM_AGERESULTS, &
CPFEM_COLLECT, &
CPFEM_RESTOREJACOBIAN, &
CPFEM_BACKUPJACOBIAN, &
cycleCounter, &
theInc, &
theTime, &
theDelta, &
lastIncConverged, &
outdatedByNewInc, &
outdatedFFN1, &
lastLovl
implicit none
!$ include "omp_lib.h" ! the openMP function library
integer(pInt), intent(in) :: & ! according to MSC.Marc 2012 Manual D
ngens, & !< size of stress-strain law
nn, & !< integration point number
ndi, & !< number of direct components
nshear, & !< number of shear components
ncrd, & !< number of coordinates
itel, & !< dimension of F and R, either 2 or 3
ndeg, & !< number of degrees of freedom
ndm, & !< not specified in MSC.Marc 2012 Manual D
nnode, & !< number of nodes per element
jtype, & !< element type
ifr, & !< set to 1 if R has been calculated
ifu !< set to 1 if stretch has been calculated
integer(pInt), dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D
m, & !< (1) user element number, (2) internal element number
matus, & !< (1) user material identification number, (2) internal material identification number
kcus, & !< (1) layer number, (2) internal layer number
lclass !< (1) element class, (2) 0: displacement, 1: low order Herrmann, 2: high order Herrmann
real(pReal), dimension(*), intent(in) :: & ! has dimension(1) according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(*)
e, & !< total elastic strain
de, & !< increment of strain
dt !< increment of state variables
real(pReal), dimension(itel), intent(in) :: & ! according to MSC.Marc 2012 Manual D
strechn, & !< square of principal stretch ratios, lambda(i) at t=n
strechn1 !< square of principal stretch ratios, lambda(i) at t=n+1
real(pReal), dimension(3,3), intent(in) :: & ! has dimension(itel,*) according to MSC.Marc 2012 Manual D, but we alway assume dimension(3,3)
ffn, & !< deformation gradient at t=n
ffn1 !< deformation gradient at t=n+1
real(pReal), dimension(itel,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
frotn, & !< rotation tensor at t=n
eigvn, & !< i principal direction components for j eigenvalues at t=n
frotn1, & !< rotation tensor at t=n+1
eigvn1 !< i principal direction components for j eigenvalues at t=n+1
real(pReal), dimension(ndeg,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
disp, & !< incremental displacements
dispt !< displacements at t=n (at assembly, lovl=4) and displacements at t=n+1 (at stress recovery, lovl=6)
real(pReal), dimension(ncrd,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
coord !< coordinates
real(pReal), dimension(*), intent(inout) :: & ! according to MSC.Marc 2012 Manual D
t !< state variables (comes in at t=n, must be updated to have state variables at t=n+1)
real(pReal), dimension(ndi+nshear), intent(out) :: & ! has dimension(*) according to MSC.Marc 2012 Manual D, but we need to loop over it
s, & !< stress - should be updated by user
g !< change in stress due to temperature effects
real(pReal), dimension(ngens,ngens), intent(out) :: & ! according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(ngens,*)
d !< stress-strain law to be formed
!--------------------------------------------------------------------------------------------------
! Marc common blocks are in fixed format so they have to be reformated to free format (f90)
! Beware of changes in newer Marc versions
#include QUOTE(PASTE(../lib/MarcInclude/concom,Marc4DAMASK)) ! concom is needed for inc, lovl
#include QUOTE(PASTE(../lib/MarcInclude/creeps,Marc4DAMASK)) ! creeps is needed for timinc (time increment)
logical :: cutBack
real(pReal), dimension(6) :: stress
real(pReal), dimension(6,6) :: ddsdde
integer(pInt) :: computationMode, i, cp_en, node, CPnodeID
!$ integer :: defaultNumThreadsInt !< default value set by Marc
if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0_pInt) then
write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn
write(6,'(a,2(1i))'), ' Jacobian: ', ngens,ngens
write(6,'(a,1i)'), ' Direct stress: ', ndi
write(6,'(a,1i)'), ' Shear stress: ', nshear
write(6,'(a,1i)'), ' DoF: ', ndeg
write(6,'(a,1i)'), ' Coordinates: ', ncrd
write(6,'(a,1i)'), ' Nodes: ', nnode
write(6,'(a,1i)'), ' Deformation gradient: ', itel
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n:', &
math_transpose33(ffn)
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n+1:', &
math_transpose33(ffn1)
endif
!$ defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc
if (.not. CPFEM_init_done) call CPFEM_initAll(m(1),nn)
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
computationMode = 0_pInt ! save initialization value, since it does not result in any calculation
if (lovl == 4 ) then ! jacobian requested by marc
if (timinc < theDelta .and. theInc == inc .and. lastLovl /= lovl) & ! first after cutback
computationMode = CPFEM_RESTOREJACOBIAN
elseif (lovl == 6) then ! stress requested by marc
cp_en = mesh_FEasCP('elem',m(1))
if (cptim > theTime .or. inc /= theInc) then ! reached "convergence"
terminallyIll = .false.
cycleCounter = -1 ! first calc step increments this to cycle = 0
if (inc == 0) then ! >> start of analysis <<
lastIncConverged = .false. ! no Jacobian backup
outdatedByNewInc = .false. ! no aging of state
calcMode = .false. ! pretend last step was collection
lastLovl = lovl ! pretend that this is NOT the first after a lovl change
!$OMP CRITICAL (write2out)
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> start of analysis..! ',m(1),nn
flush(6)
!$OMP END CRITICAL (write2out)
else if (inc - theInc > 1) then ! >> restart of broken analysis <<
lastIncConverged = .false. ! no Jacobian backup
outdatedByNewInc = .false. ! no aging of state
calcMode = .true. ! pretend last step was calculation
!$OMP CRITICAL (write2out)
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> restart of analysis..! ',m(1),nn
flush(6)
!$OMP END CRITICAL (write2out)
else ! >> just the next inc <<
lastIncConverged = .true. ! request Jacobian backup
outdatedByNewInc = .true. ! request aging of state
calcMode = .true. ! assure last step was calculation
!$OMP CRITICAL (write2out)
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> new increment..! ',m(1),nn
flush(6)
!$OMP END CRITICAL (write2out)
endif
else if ( timinc < theDelta ) then ! >> cutBack <<
lastIncConverged = .false. ! no Jacobian backup
outdatedByNewInc = .false. ! no aging of state
terminallyIll = .false.
cycleCounter = -1 ! first calc step increments this to cycle = 0
calcMode = .true. ! pretend last step was calculation
!$OMP CRITICAL (write2out)
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> cutback detected..! ',m(1),nn
flush(6)
!$OMP END CRITICAL (write2out)
endif ! convergence treatment end
if (usePingPong) then
calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect)
if (calcMode(nn,cp_en)) then ! now --- CALC ---
computationMode = CPFEM_CALCRESULTS
if (lastLovl /= lovl) then ! first after ping pong
call debug_reset() ! resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1_pInt
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
call mesh_build_ipCoordinates() ! update ip coordinates
endif
if (outdatedByNewInc) then
computationMode = ior(computationMode,CPFEM_AGERESULTS) ! calc and age results
outdatedByNewInc = .false. ! reset flag
endif
else ! now --- COLLECT ---
computationMode = CPFEM_COLLECT ! plain collect
if (lastLovl /= lovl .and. & .not. terminallyIll) &
call debug_info() ! first after ping pong reports (meaningful) debugging
if (lastIncConverged) then
computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence
lastIncConverged = .false. ! reset flag
endif
do node = 1,FE_Nnodes(mesh_element(2,cp_en))
CPnodeID = mesh_element(4_pInt+node,cp_en)
mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
enddo
endif
else ! --- PLAIN MODE ---
computationMode = CPFEM_CALCRESULTS ! always calc
if (lastLovl /= lovl) then
if (.not. terminallyIll) &
call debug_info() ! first reports (meaningful) debugging
call debug_reset() ! and resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1_pInt
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
call mesh_build_ipCoordinates() ! update ip coordinates
endif
if (outdatedByNewInc) then
computationMode = ior(computationMode,CPFEM_AGERESULTS)
outdatedByNewInc = .false. ! reset flag
endif
if (lastIncConverged) then
computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! backup Jacobian after convergence
lastIncConverged = .false. ! reset flag
endif
endif
theTime = cptim ! record current starting time
theDelta = timinc ! record current time increment
theInc = inc ! record current increment number
endif
lastLovl = lovl ! record lovl
call CPFEM_general(computationMode,usePingPong,ffn,ffn1,t(1),timinc,m(1),nn,stress,ddsdde)
! Mandel: 11, 22, 33, SQRT(2)*12, SQRT(2)*23, SQRT(2)*13
! Marc: 11, 22, 33, 12, 23, 13
! Marc: 11, 22, 33, 12
forall(i=1:ngens) d(1:ngens,i) = invnrmMandel(i)*ddsdde(1:ngens,i)*invnrmMandel(1:ngens)
s(1:ndi+nshear) = stress(1:ndi+nshear)*invnrmMandel(1:ndi+nshear)
g = 0.0_pReal
if(symmetricSolver) d = 0.5_pReal*(d+transpose(d))
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
end subroutine hypela2
!--------------------------------------------------------------------------------------------------
!> @brief sets user defined output variables for Marc
!> @details select a variable contour plotting (user subroutine).
!--------------------------------------------------------------------------------------------------
subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
use prec, only: &
pReal, &
pInt
use mesh, only: &
mesh_FEasCP
use IO, only: &
IO_error
use homogenization, only: &
materialpoint_results,&
materialpoint_sizeResults
implicit none
integer(pInt), intent(in) :: &
m, & !< element number
nn, & !< integration point number
layer, & !< layer number
ndi, & !< number of direct stress components
nshear, & !< number of shear stress components
jpltcd !< user variable index
real(pReal), dimension(*), intent(in) :: &
s, & !< stress array
sp, & !< stresses in preferred direction
etot, & !< total strain (generalized)
eplas, & !< total plastic strain
ecreep, & !< total creep strain
t !< current temperature
real(pReal), intent(out) :: &
v !< variable
if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd) ! complain about out of bounds error
v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m))
end subroutine plotv

1
src/DAMASK_marc2011.f90 Symbolic link
View File

@ -0,0 +1 @@
DAMASK_marc.f90

1
src/DAMASK_marc2012.f90 Symbolic link
View File

@ -0,0 +1 @@
DAMASK_marc.f90

1
src/DAMASK_marc2013.1.f90 Symbolic link
View File

@ -0,0 +1 @@
DAMASK_marc.f90

1
src/DAMASK_marc2013.f90 Symbolic link
View File

@ -0,0 +1 @@
DAMASK_marc.f90

1
src/DAMASK_marc2014.2.f90 Symbolic link
View File

@ -0,0 +1 @@
DAMASK_marc.f90

1
src/DAMASK_marc2014.f90 Symbolic link
View File

@ -0,0 +1 @@
DAMASK_marc.f90

1
src/DAMASK_marc2015.f90 Symbolic link
View File

@ -0,0 +1 @@
DAMASK_marc.f90

751
src/DAMASK_spectral.f90 Normal file
View File

@ -0,0 +1,751 @@
!--------------------------------------------------------------------------------------------------
! $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 Driver controlling inner and outer load case looping of the various spectral solvers
!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing
!> results
!--------------------------------------------------------------------------------------------------
program DAMASK_spectral
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, &
pLongInt, &
pReal, &
tol_math_check
use DAMASK_interface, only: &
DAMASK_interface_init, &
loadCaseFile, &
geometryFile, &
getSolverWorkingDirectoryName, &
getSolverJobName, &
appendToOutFile
use IO, only: &
IO_read, &
IO_isBlank, &
IO_open_file, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_error, &
IO_lc, &
IO_intOut, &
IO_warning, &
IO_timeStamp, &
IO_EOF
use debug, only: &
debug_level, &
debug_spectral, &
debug_levelBasic
use math ! need to include the whole module for FFTW
use mesh, only: &
grid, &
geomSize
use CPFEM2, only: &
CPFEM_initAll
use FEsolving, only: &
restartWrite, &
restartInc
use numerics, only: &
worldrank, &
worldsize, &
stagItMax, &
maxCutBack, &
spectral_solver, &
continueCalculation
use homogenization, only: &
materialpoint_sizeResults, &
materialpoint_results, &
materialpoint_postResults
use material, only: &
thermal_type, &
damage_type, &
THERMAL_conduction_ID, &
DAMAGE_nonlocal_ID
use spectral_utilities, only: &
utilities_init, &
utilities_destroy, &
tSolutionState, &
tLoadCase, &
cutBack, &
nActiveFields, &
FIELD_UNDEFINED_ID, &
FIELD_MECH_ID, &
FIELD_THERMAL_ID, &
FIELD_DAMAGE_ID
use spectral_mech_Basic
use spectral_mech_AL
use spectral_mech_Polarisation
use spectral_damage
use spectral_thermal
implicit none
#include <petsc/finclude/petscsys.h>
!--------------------------------------------------------------------------------------------------
! variables related to information from load case and geom file
real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors
integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
N_t = 0_pInt, & !< # of time indicators found in load case file
N_n = 0_pInt, & !< # of increment specifiers found in load case file
N_def = 0_pInt !< # of rate of deformation specifiers found in load case file
character(len=65536) :: &
line
!--------------------------------------------------------------------------------------------------
! loop variables, convergence etc.
real(pReal), dimension(3,3), parameter :: &
ones = 1.0_pReal, &
zeros = 0.0_pReal
integer(pInt), parameter :: &
subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0
real(pReal) :: &
time = 0.0_pReal, & !< elapsed time
time0 = 0.0_pReal, & !< begin of interval
timeinc = 1.0_pReal, & !< current time interval
timeIncOld = 0.0_pReal, & !< previous time interval
remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case
logical :: &
guess, & !< guess along former trajectory
stagIterate
integer(pInt) :: &
i, j, k, l, field, &
errorID, &
cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0_pInt !< fraction of current time interval
integer(pInt) :: &
currentLoadcase = 0_pInt, & !< current load case
inc, & !< current increment in current load case
totalIncsCounter = 0_pInt, & !< total # of increments
convergedCounter = 0_pInt, & !< # of converged increments
notConvergedCounter = 0_pInt, & !< # of non-converged increments
resUnit = 0_pInt, & !< file unit for results writing
statUnit = 0_pInt, & !< file unit for statistics output
lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written
stagIter
character(len=6) :: loadcase_string
character(len=1024) :: incInfo !< string parsed to solution with information about current load case
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tSolutionState), allocatable, dimension(:) :: solres
integer(MPI_OFFSET_KIND) :: fileOffset
integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize
integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
integer(pLongInt), dimension(2) :: outputIndex
PetscErrorCode :: ierr
external :: &
quit, &
MPI_file_open, &
MPI_file_close, &
MPI_file_seek, &
MPI_file_get_position, &
MPI_file_write, &
MPI_allreduce
!--------------------------------------------------------------------------------------------------
! init DAMASK (all modules)
call CPFEM_initAll(el = 1_pInt, ip = 1_pInt)
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
!--------------------------------------------------------------------------------------------------
! initialize field solver information
nActiveFields = 1
if (any(thermal_type == THERMAL_conduction_ID )) nActiveFields = nActiveFields + 1
if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1
allocate(solres(nActiveFields))
!--------------------------------------------------------------------------------------------------
! reading basic information from load case file and allocate data structure containing load cases
call IO_open_file(FILEUNIT,trim(loadCaseFile))
rewind(FILEUNIT)
do
line = IO_read(FILEUNIT)
if (trim(line) == IO_EOF) exit
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f')
N_def = N_def + 1_pInt
case('t','time','delta')
N_t = N_t + 1_pInt
case('n','incs','increments','steps','logincs','logincrements','logsteps')
N_n = N_n + 1_pInt
end select
enddo ! count all identifiers to allocate memory and do sanity check
enddo
if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check
call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase
allocate (loadCases(N_n)) ! array of load cases
loadCases%P%myType='p'
do i = 1, size(loadCases)
allocate(loadCases(i)%ID(nActiveFields))
field = 1
loadCases(i)%ID(field) = FIELD_MECH_ID ! mechanical active by default
if (any(thermal_type == THERMAL_conduction_ID)) then ! thermal field active
field = field + 1
loadCases(i)%ID(field) = FIELD_THERMAL_ID
endif
if (any(damage_type == DAMAGE_nonlocal_ID)) then ! damage field active
field = field + 1
loadCases(i)%ID(field) = FIELD_DAMAGE_ID
endif
enddo
!--------------------------------------------------------------------------------------------------
! reading the load case and assign values to the allocated data structure
rewind(FILEUNIT)
do
line = IO_read(FILEUNIT)
if (trim(line) == IO_EOF) exit
if (IO_isBlank(line)) cycle ! skip empty lines
currentLoadCase = currentLoadCase + 1_pInt
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix
temp_valueVector = 0.0_pReal
if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot
IO_lc(IO_stringValue(line,chunkPos,i)) == 'dotf') then
loadCases(currentLoadCase)%deformation%myType = 'fdot'
else if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'f') then
loadCases(currentLoadCase)%deformation%myType = 'f'
else
loadCases(currentLoadCase)%deformation%myType = 'l'
endif
do j = 1_pInt, 9_pInt
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a *
enddo
do j = 1_pInt,9_pInt
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
enddo
loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation
transpose(reshape(temp_maskVector,[ 3,3]))
loadCases(currentLoadCase)%deformation%maskFloat = & ! float (1.0/0.0) mask in 3x3 notation
merge(ones,zeros,loadCases(currentLoadCase)%deformation%maskLogical)
loadCases(currentLoadCase)%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation
case('p','pk1','piolakirchhoff','stress', 's')
temp_valueVector = 0.0_pReal
do j = 1_pInt, 9_pInt
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk
enddo
do j = 1_pInt,9_pInt
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
enddo
loadCases(currentLoadCase)%P%maskLogical = transpose(reshape(temp_maskVector,[ 3,3]))
loadCases(currentLoadCase)%P%maskFloat = merge(ones,zeros,&
loadCases(currentLoadCase)%P%maskLogical)
loadCases(currentLoadCase)%P%values = math_plain9to33(temp_valueVector)
case('t','time','delta') ! increment time
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt)
case('n','incs','increments','steps') ! number of increments
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
loadCases(currentLoadCase)%logscale = 1_pInt
case('freq','frequency','outputfreq') ! frequency of result writings
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
case('r','restart','restartwrite') ! frequency of writing restart information
loadCases(currentLoadCase)%restartfrequency = &
max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt))
case('guessreset','dropguessing')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
case('euler') ! rotation of currentLoadCase given in euler angles
temp_valueVector = 0.0_pReal
l = 1_pInt ! assuming values given in degrees
k = 1_pInt ! assuming keyword indicating degree/radians present
select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt)))
case('deg','degree')
case('rad','radian') ! don't convert from degree to radian
l = 0_pInt
case default
k = 0_pInt
end select
do j = 1_pInt, 3_pInt
temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j)
enddo
if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad
loadCases(currentLoadCase)%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix
case('rotation','rot') ! assign values for the rotation of currentLoadCase matrix
temp_valueVector = 0.0_pReal
do j = 1_pInt, 9_pInt
temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j)
enddo
loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector)
end select
enddo; enddo
close(FILEUNIT)
!--------------------------------------------------------------------------------------------------
! consistency checks and output of load case
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
errorID = 0_pInt
if (worldrank == 0) then
checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases)
write (loadcase_string, '(i6)' ) currentLoadCase
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
write(6,'(2x,a)') 'drop guessing along trajectory'
if (loadCases(currentLoadCase)%deformation%myType=='l') then
do j = 1_pInt, 3_pInt
if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) &
errorID = 832_pInt ! each row should be either fully or not at all defined
enddo
write(6,'(2x,a)') 'velocity gradient:'
else if (loadCases(currentLoadCase)%deformation%myType=='f') then
write(6,'(2x,a)') 'deformation gradient at end of load case:'
else
write(6,'(2x,a)') 'deformation gradient rate:'
endif
do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
if(loadCases(currentLoadCase)%deformation%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%deformation%values(i,j)
else
write(6,'(2x,12a)',advance='no') ' * '
endif
enddo; write(6,'(/)',advance='no')
enddo
if (any(loadCases(currentLoadCase)%P%maskLogical .eqv. &
loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
if (any(loadCases(currentLoadCase)%P%maskLogical .and. &
transpose(loadCases(currentLoadCase)%P%maskLogical) .and. &
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
errorID = 838_pInt ! no rotation is allowed by stress BC
write(6,'(2x,a)') 'stress / GPa:'
do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
if(loadCases(currentLoadCase)%deformation%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%P%values(i,j)*1e-9_pReal
else
write(6,'(2x,12a)',advance='no') ' * '
endif
enddo; write(6,'(/)',advance='no')
enddo
if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, &
math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) >&
reshape(spread(tol_math_check,1,9),[ 3,3]))&
.or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > &
1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain
if (any(loadCases(currentLoadCase)%rotation /= math_I3)) &
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
math_transpose33(loadCases(currentLoadCase)%rotation)
if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', &
loadCases(currentLoadCase)%outputfrequency
write(6,'(2x,a,i5,/)') 'restart frequency: ', &
loadCases(currentLoadCase)%restartfrequency
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
enddo checkLoadcases
endif
!--------------------------------------------------------------------------------------------------
! doing initialization depending on selected solver
call Utilities_init()
do field = 1, nActiveFields
select case (loadCases(1)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
call basicPETSc_init
case (DAMASK_spectral_SolverAL_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0 .and. worldrank == 0_pInt) &
call IO_warning(42_pInt, ext_msg='debug Divergence')
call AL_init
case (DAMASK_spectral_SolverPolarisation_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0 .and. worldrank == 0_pInt) &
call IO_warning(42_pInt, ext_msg='debug Divergence')
call Polarisation_init
case default
call IO_error(error_ID = 891, ext_msg = trim(spectral_solver))
end select
case(FIELD_THERMAL_ID)
call spectral_thermal_init
case(FIELD_DAMAGE_ID)
call spectral_damage_init()
end select
enddo
!--------------------------------------------------------------------------------------------------
! write header of output file
if (worldrank == 0) then
if (.not. appendToOutFile) then ! after restart, append to existing results file
open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE')
write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header
write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName())
write(resUnit) 'geometry:', trim(geometryFile)
write(resUnit) 'grid:', grid
write(resUnit) 'size:', geomSize
write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults
write(resUnit) 'loadcases:', size(loadCases)
write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase
write(resUnit) 'times:', loadCases%time ! one entry per LoadCase
write(resUnit) 'logscales:', loadCases%logscale
write(resUnit) 'increments:', loadCases%incs ! one entry per LoadCase
write(resUnit) 'startingIncrement:', restartInc - 1_pInt ! start with writing out the previous inc
write(resUnit) 'eoh'
close(resUnit) ! end of header
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
write(6,'(/,a)') ' header of result and statistics file written out'
flush(6)
else ! open new files ...
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD')
endif
endif
!--------------------------------------------------------------------------------------------------
! prepare MPI parallel out (including opening of file)
allocate(outputSize(worldsize), source = 0_MPI_OFFSET_KIND)
outputSize(worldrank+1) = int(size(materialpoint_results)*pReal,MPI_OFFSET_KIND)
call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
call MPI_file_open(PETSC_COMM_WORLD, &
trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', &
MPI_MODE_WRONLY + MPI_MODE_APPEND, &
MPI_INFO_NULL, &
resUnit, &
ierr)
call MPI_file_get_position(resUnit,fileOffset,ierr) ! get offset from header
fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me)
call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr)
if (.not. appendToOutFile) then ! if not restarting, write 0th increment
do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex=[(i-1)*((maxByteOut/pReal)/materialpoint_sizeResults)+1, &
min(i*((maxByteOut/pReal)/materialpoint_sizeResults),size(materialpoint_results,3))]
call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
[(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), &
(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults,&
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
enddo
if (worldrank == 0) &
write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
endif
!--------------------------------------------------------------------------------------------------
! loopping over loadcases
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
time0 = time ! currentLoadCase start time
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
!--------------------------------------------------------------------------------------------------
! loop oper incs defined in input file for current currentLoadCase
incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1_pInt
!--------------------------------------------------------------------------------------------------
! forwarding time
timeIncOld = timeinc
if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale
timeinc = loadCases(currentLoadCase)%time/loadCases(currentLoadCase)%incs ! only valid for given linear time scale. will be overwritten later in case loglinear scale is used
else
if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale
if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
else ! not-1st inc of 1st currentLoadCase of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal))
endif
else ! not-1st currentLoadCase of logarithmic scale
timeinc = time0 * &
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal))&
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( (inc-1_pInt),pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal)))
endif
endif
timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step
forwarding: if(totalIncsCounter >= restartInc) then
stepFraction = 0_pInt
!--------------------------------------------------------------------------------------------------
! loop over sub incs
subIncLooping: do while (stepFraction/subStepFactor**cutBackLevel <1_pInt)
time = time + timeinc ! forward time
stepFraction = stepFraction + 1_pInt
remainingLoadCaseTime = time0 - time + loadCases(currentLoadCase)%time + timeInc
!--------------------------------------------------------------------------------------------------
! report begin of new increment
if (worldrank == 0) then
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,a,es12.5'//&
',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//&
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//&
',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') &
'Time', time, &
's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
'-', stepFraction, '/', subStepFactor**cutBackLevel,&
' of load case ', currentLoadCase,'/',size(loadCases)
flush(6)
write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//&
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') &
'Increment ',totalIncsCounter,'/',sum(loadCases%incs),&
'-',stepFraction, '/', subStepFactor**cutBackLevel
endif
!--------------------------------------------------------------------------------------------------
! forward fields
do field = 1, nActiveFields
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
call BasicPETSc_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, &
F_BC = loadCases(currentLoadCase)%deformation, &
P_BC = loadCases(currentLoadCase)%P, &
rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverAL_label)
call AL_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, &
F_BC = loadCases(currentLoadCase)%deformation, &
P_BC = loadCases(currentLoadCase)%P, &
rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverPolarisation_label)
call Polarisation_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, &
F_BC = loadCases(currentLoadCase)%deformation, &
P_BC = loadCases(currentLoadCase)%P, &
rotation_BC = loadCases(currentLoadCase)%rotation)
end select
case(FIELD_THERMAL_ID)
call spectral_thermal_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime)
case(FIELD_DAMAGE_ID)
call spectral_damage_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime)
end select
enddo
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 0_pInt
stagIterate = .true.
do while (stagIterate)
do field = 1, nActiveFields
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
solres(field) = BasicPETSC_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, &
P_BC = loadCases(currentLoadCase)%P, &
F_BC = loadCases(currentLoadCase)%deformation, &
rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverAL_label)
solres(field) = AL_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, &
P_BC = loadCases(currentLoadCase)%P, &
F_BC = loadCases(currentLoadCase)%deformation, &
rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverPolarisation_label)
solres(field) = Polarisation_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, &
P_BC = loadCases(currentLoadCase)%P, &
F_BC = loadCases(currentLoadCase)%deformation, &
rotation_BC = loadCases(currentLoadCase)%rotation)
end select
case(FIELD_THERMAL_ID)
solres(field) = spectral_thermal_solution (&
guess,timeinc,timeIncOld,remainingLoadCaseTime)
case(FIELD_DAMAGE_ID)
solres(field) = spectral_damage_solution (&
guess,timeinc,timeIncOld,remainingLoadCaseTime)
end select
if(.not. solres(field)%converged) exit ! no solution found
enddo
stagIter = stagIter + 1_pInt
stagIterate = stagIter < stagItMax .and. &
all(solres(:)%converged) .and. &
.not. all(solres(:)%stagConverged)
enddo
!--------------------------------------------------------------------------------------------------
! check solution
cutBack = .False.
if(solres(1)%termIll .or. .not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found
if (cutBackLevel < maxCutBack) then ! do cut back
if (worldrank == 0) write(6,'(/,a)') ' cut back detected'
cutBack = .True.
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1_pInt
time = time - timeinc ! rewind time
timeinc = timeinc/2.0_pReal
elseif (solres(1)%termIll) then ! material point model cannot find a solution, exit in any casy
call IO_warning(850_pInt)
call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written (e.g. for regridding)
elseif (continueCalculation == 1_pInt) then
guess = .true. ! accept non converged BVP solution
else ! default behavior, exit if spectral solver does not converge
call IO_warning(850_pInt)
call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written (e.g. for regridding)
endif
else
guess = .true. ! start guessing after first converged (sub)inc
endif
if (.not. cutBack) then
if (worldrank == 0) then
write(statUnit,*) totalIncsCounter, time, cutBackLevel, &
solres%converged, solres%iterationsNeeded ! write statistics about accepted solution
flush(statUnit)
endif
endif
enddo subIncLooping
cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc
if(all(solres(:)%converged)) then ! report converged inc
convergedCounter = convergedCounter + 1_pInt
if (worldrank == 0) &
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') &
' increment ', totalIncsCounter, ' converged'
else
if (worldrank == 0) &
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
' increment ', totalIncsCounter, ' NOT converged'
notConvergedCounter = notConvergedCounter + 1_pInt
endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency
if (worldrank == 0) &
write(6,'(1/,a)') ' ... writing results to file ......................................'
call materialpoint_postResults()
call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr)
do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex=[(i-1)*maxByteOut/pReal/materialpoint_sizeResults+1, &
min(i*maxByteOut/pReal/materialpoint_sizeResults,size(materialpoint_results,3))]
call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
[(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), &
(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults,&
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
enddo
endif
if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving
mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! first call to CPFEM_general will write?
restartWrite = .true.
lastRestartWritten = inc
endif
else forwarding
time = time + timeinc
guess = .true.
endif forwarding
enddo incLooping
enddo loadCaseLooping
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
if (worldrank == 0) then
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,i6.6,a,i6.6,a,f5.1,a)') convergedCounter, ' out of ', &
notConvergedCounter + convergedCounter, ' (', &
real(convergedCounter, pReal)/&
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, &
' %) increments converged!'
endif
call MPI_file_close(resUnit,ierr)
close(statUnit)
do field = 1, nActiveFields
select case(loadCases(1)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
call BasicPETSC_destroy()
case (DAMASK_spectral_SolverAL_label)
call AL_destroy()
case (DAMASK_spectral_SolverPolarisation_label)
call Polarisation_destroy()
end select
case(FIELD_THERMAL_ID)
call spectral_thermal_destroy()
case(FIELD_DAMAGE_ID)
call spectral_damage_destroy()
end select
enddo
call utilities_destroy()
call PetscFinalize(ierr); CHKERRQ(ierr)
if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged
call quit(0_pInt) ! no complains ;)
end program DAMASK_spectral
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief quit subroutine to mimic behavior of FEM solvers
!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals
!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code
!> 2 signals request for regridding, increment of last saved restart information is written to
!> stderr. Exit code 3 signals no severe problems, but some increments did not converge
!--------------------------------------------------------------------------------------------------
subroutine quit(stop_id)
use prec, only: &
pInt
use numerics, only: &
worldrank
implicit none
integer(pInt), intent(in) :: stop_id
integer, dimension(8) :: dateAndTime ! type default integer
if (worldrank == 0_pInt) then
call date_and_time(values = dateAndTime)
write(6,'(/,a)') 'DAMASK terminated on:'
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)
endif
if (stop_id == 0_pInt) stop 0 ! normal termination
if (stop_id < 0_pInt) then ! trigger regridding
if (worldrank == 0_pInt) &
write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt)
stop 2
endif
if (stop_id == 3_pInt) stop 3 ! not all incs converged
stop 1 ! error (message from IO_error)
end subroutine quit

171
src/FEsolving.f90 Normal file
View File

@ -0,0 +1,171 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief triggering reading in of restart information when doing a restart
!> @todo Descriptions for public variables needed
!--------------------------------------------------------------------------------------------------
module FEsolving
use prec, only: &
pInt, &
pReal
implicit none
private
integer(pInt), public :: &
restartInc = 1_pInt !< needs description
logical, public :: &
symmetricSolver = .false., & !< use a symmetric FEM solver
restartWrite = .false., & !< write current state to enable restart
restartRead = .false., & !< restart information to continue calculation from saved state
terminallyIll = .false. !< at least one material point is terminally ill
integer(pInt), dimension(:,:), allocatable, public :: &
FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP
integer(pInt), dimension(2), public :: &
FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element
character(len=1024), public :: &
modelName !< needs description
logical, dimension(:,:), allocatable, public :: &
calcMode !< do calculation or simply collect when using ping pong scheme
public :: FE_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief determine whether a symmetric solver is used and whether restart is requested
!> @details restart information is found in input file in case of FEM solvers, in case of spectal
!> solver the information is provided by the interface module
!--------------------------------------------------------------------------------------------------
subroutine FE_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_FEsolving, &
debug_levelBasic
use IO, only: &
IO_stringPos, &
IO_stringValue, &
IO_intValue, &
IO_lc, &
#if defined(Marc4DAMASK) || defined(Abaqus)
IO_open_inputFile, &
IO_open_logFile, &
#endif
IO_warning, &
IO_timeStamp
use DAMASK_interface
use numerics, only: &
worldrank
implicit none
#if defined(Marc4DAMASK) || defined(Abaqus)
integer(pInt), parameter :: &
FILEUNIT = 222_pInt
integer(pInt) :: j
character(len=65536) :: tag, line
integer(pInt), allocatable, dimension(:) :: chunkPos
#endif
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
modelName = getSolverJobName()
#ifdef Spectral
restartInc = spectralRestartInc
if(restartInc <= 0_pInt) then
call IO_warning(warning_ID=34_pInt)
restartInc = 1_pInt
endif
restartRead = restartInc > 1_pInt ! only read in if "true" restart requested
#elif defined FEM
restartInc = FEMRestartInc
if(restartInc <= 0_pInt) then
call IO_warning(warning_ID=34_pInt)
restartInc = 1_pInt
endif
restartRead = restartInc > 1_pInt
#else
call IO_open_inputFile(FILEUNIT,modelName)
rewind(FILEUNIT)
do
read (FILEUNIT,'(a1024)',END=100) line
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('solver')
read (FILEUNIT,'(a1024)',END=100) line ! next line
chunkPos = IO_stringPos(line)
symmetricSolver = (IO_intValue(line,chunkPos,2_pInt) /= 1_pInt)
case ('restart')
read (FILEUNIT,'(a1024)',END=100) line ! next line
chunkPos = IO_stringPos(line)
restartWrite = iand(IO_intValue(line,chunkPos,1_pInt),1_pInt) > 0_pInt
restartRead = iand(IO_intValue(line,chunkPos,1_pInt),2_pInt) > 0_pInt
case ('*restart')
do j=2_pInt,chunkPos(1)
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite
restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead
enddo
if(restartWrite) then
do j=2_pInt,chunkPos(1)
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite
enddo
endif
end select
enddo
100 close(FILEUNIT)
if (restartRead) then
#ifdef Marc4DAMASK
call IO_open_logFile(FILEUNIT)
rewind(FILEUNIT)
do
read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line)
if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'restart' .and. &
IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'file' .and. &
IO_lc(IO_stringValue(line,chunkPos,3_pInt)) == 'job' .and. &
IO_lc(IO_stringValue(line,chunkPos,4_pInt)) == 'id' ) &
modelName = IO_StringValue(line,chunkPos,6_pInt)
enddo
#else
call IO_open_inputFile(FILEUNIT,modelName)
rewind(FILEUNIT)
do
read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line)
if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))=='*heading') then
read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line)
modelName = IO_StringValue(line,chunkPos,1_pInt)
endif
enddo
#endif
200 close(FILEUNIT)
endif
!--------------------------------------------------------------------------------------------------
! the following array are allocated by mesh.f90 and need to be deallocated in case of regridding
if (allocated(calcMode)) deallocate(calcMode)
if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP)
#endif
if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0_pInt) then
write(6,'(a21,l1)') ' restart writing: ', restartWrite
write(6,'(a21,l1)') ' restart reading: ', restartRead
if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName)
endif
end subroutine FE_init
end module FEsolving

2470
src/IO.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

701
src/Makefile Normal file
View File

@ -0,0 +1,701 @@
SHELL = /bin/sh
########################################################################################
# Makefile to compile the Material subroutine for BVP solution using spectral method
########################################################################################
# Be sure to remove all files compiled with different options by using "make clean"
########################################################################################
# OPTIONS = standard (alternative): meaning
#-------------------------------------------------------------
# F90 = ifort (gfortran): compiler type, choose Intel or GNU
# COMPILERNAME = name of the compiler executable (if not the same as the ype), e.g. using mpich-g90 instead of ifort
# PORTABLE = TRUE (FALSE): decision, if executable is optimized for the machine on which it was built.
# OPTIMIZATION = DEFENSIVE (OFF,AGGRESSIVE,ULTRA): Optimization mode: O2, O0, O3 + further options for most files, O3 + further options for all files
# OPENMP = TRUE (FALSE): OpenMP multiprocessor support
# PREFIX = arbitrary prefix (before compilername)
# OPTION = arbitrary option (just before file to compile)
# SUFFIX = arbitrary suffix (after file to compile)
# STANDARD_CHECK = checking for Fortran 2008, compiler dependend
########################################################################################
# including PETSc files. PETSC_ARCH is loaded from these files.
DAMASKVERSION :=$(shell cat ../VERSION)
include ${PETSC_DIR}/lib/petsc/conf/variables
include ${PETSC_DIR}/lib/petsc/conf/rules
INCLUDE_DIRS := $(PETSC_FC_INCLUDES) -DPETSc -I../lib
LIBRARIES := $(PETSC_WITH_EXTERNAL_LIB)
COMPILERNAME ?= $(FC)
LINKERNAME ?= $(FLINKER)
#
# setting up for HDF5 support (hard link for now)
# 1. Location of HDF5 binaries (with include/ and lib/ underneath)
HDF5 = /mnt/research/CMM/opt/hdf5
# 2. Location of External Libraries (missing in the 1.8.12 version)
LIBZ = /mnt/research/CMM/opt/hdf5/lib/libz.a
LIBSZ = /mnt/research/CMM/opt/hdf5/lib/libszip.a
# 3. Set libraries for HDF5 (LIBS: shared lib, LIBZ: external lib)
HDFLIBS = -I$(HDF5)/include -L$(HDF5)/lib
HDFLIBZ = -L$(LIBZ) -L$(LIBSZ)
# MPI compiler wrappers will tell if they are pointing to ifort or gfortran
COMPILEROUT :=$(shell $(FC) -show)
# search in FC or COMPILEROUT for gfortran/ifort if not defined
ifeq ($(strip $(F90)),)
F90 :=$(findstring gfortran,$(FC) $(COMPILEROUT))
endif
ifeq ($(strip $(F90)),)
F90 :=$(findstring ifort,$(FC) $(COMPILEROUT))
endif
OPENMP ?= ON
OPTIMIZATION ?= DEFENSIVE
ifeq "$(OPTIMIZATION)" "OFF"
OPTI := OFF
MAXOPTI := OFF
endif
ifeq "$(OPTIMIZATION)" "DEFENSIVE"
OPTI := DEFENSIVE
MAXOPTI := DEFENSIVE
endif
ifeq "$(OPTIMIZATION)" "AGGRESSIVE"
OPTI := AGGRESSIVE
MAXOPTI := DEFENSIVE
endif
ifeq "$(OPTIMIZATION)" "ULTRA"
OPTI := AGGRESSIVE
MAXOPTI := AGGRESSIVE
endif
ifndef OPTI
OPTI := DEFENSIVE
MAXOPTI := DEFENSIVE
endif
# settings for shared memory multicore support
ifeq "$(OPENMP)" "ON"
OPENMP_FLAG_ifort =-openmp -openmp-report0 -parallel
OPENMP_FLAG_gfortran =-fopenmp
endif
ifdef STANDARD_CHECK
STANDARD_CHECK_ifort =$(STANDARD_CHECK)
STANDARD_CHECK_gfortran =$(STANDARD_CHECK)
endif
STANDARD_CHECK_ifort ?=-stand f08 -standard-semantics
STANDARD_CHECK_gfortran ?=-std=f2008ts -pedantic-errors
#-pedantic: more strict on standard, enables some warnings
# -pedantic-errors: like pedantic, but errors instead of warnings
OPTIMIZATION_OFF_ifort :=-O0 -no-ip
OPTIMIZATION_OFF_gfortran :=-O0
OPTIMIZATION_DEFENSIVE_ifort :=-O2
OPTIMIZATION_DEFENSIVE_gfortran :=-O2
OPTIMIZATION_AGGRESSIVE_ifort :=-ipo -O3 -no-prec-div -fp-model fast=2 -xHost #-fast = -ipo, -O3, -no-prec-div, -static, -fp-model fast=2, and -xHost
OPTIMIZATION_AGGRESSIVE_gfortran :=-O3 -ffast-math -funroll-loops -ftree-vectorize
LINK_OPTIONS_ifort :=-shared-intel
COMPILE_OPTIONS_ifort :=-DDAMASKVERSION=\"${DAMASKVERSION}\"\
-fpp\
-ftz\
-assume byterecl,fpe_summary\
-diag-disable 5268\
-warn declarations\
-warn general\
-warn usage\
-warn interfaces\
-warn ignore_loc\
-warn alignments\
-warn unused
###################################################################################################
#COMPILE SWITCHES
#-shared-intel: Link against shared Intel libraries instead of static ones
#-fpp: preprocessor
#-ftz: flush unterflow to zero, automatically set if O<0,1,2,3> >0
#-assume byterecl record length is given in bytes (also set by -standard-semantics)
# fpe_summary print list of floating point exceptions occured during execution
#-fimplicit-none: assume "implicit-none" even if not present in source
#-diag-disable: disables warnings, where
# warning ID 5268: the text exceeds right hand column allowed on the line (we have only comments there)
#-warn: enables warnings, where
# declarations: any undeclared names (alternative name: -implicitnone)
# general: warning messages and informational messages are issued by the compiler
# usage: questionable programming practices
# interfaces: checks the interfaces of all SUBROUTINEs called and FUNCTIONs invoked in your compilation against an external set of interface blocks
# ignore_loc: %LOC is stripped from an actual argument
# alignments: data that is not naturally aligned
# unused: declared variables that are never used
# stderrors: warnings about Fortran standard violations are changed to errors (STANDARD_CHECK)
#
###################################################################################################
#MORE OPTIONS FOR DEBUGGING DURING COMPILATION
#-warn: enables warnings, where
# truncated_source: Determines whether warnings occur when source exceeds the maximum column width in fixed-format files. (too many warnings because we have comments beyond character 132)
# uncalled: Determines whether warnings occur when a statement function is never called
# all:
# -name as_is: case sensitive Fortran!
DEBUG_OPTIONS_ifort :=-g\
-traceback\
-gen-interfaces\
-fp-stack-check\
-fp-model strict\
-check bounds,format,output_conversion,pointers,uninit\
-ftrapuv\
-fpe-all0\
-warn errors\
-warn stderrors\
-debug-parameters all
###################################################################################################
#COMPILE SWITCHES FOR RUNTIME DEBUGGING
#-g: Generate symbolic debugging information in the object file
#-traceback: Generate extra information in the object file to provide source file traceback information when a severe error occurs at run time.
#-gen-interfaces: Generate an interface block for each routine. http://software.intel.com/en-us/blogs/2012/01/05/doctor-fortran-gets-explicit-again/
#-fp-stack-check: Generate extra code after every function call to ensure that the floating-point (FP) stack is in the expected state.
#-ftrapuv Trap uninitalized variables
#-check: checks at runtime, where
# bounds: check if an array index is too small (<1) or too large!
# format: Checking for the data type of an item being formatted for output.
# output_conversion: Checking for the fit of data items within a designated format descriptor field.
# pointers: Checking for certain disassociated or uninitialized pointers or unallocated allocatable objects.
# uninit: Checking for uninitialized variables.
#-fpe-all0 capture all floating-point exceptions, sets -ftz automatically
#-warn: enables warnings, where
# errors: warnings are changed to errors
# stderrors: warnings about Fortran standard violations are changed to errors
# information on http://software.intel.com/en-us/articles/determining-root-cause-of-sigsegv-or-sigbus-errors/
###################################################################################################
#MORE OPTIONS FOR RUNTIME DEBUGGING
#-heap-arrays: should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Probably it helps also to unlimit other limits
#-check: checks at runtime, where
# arg_temp_created: will cause a lot of warnings because we create a bunch of temporary arrays (performance?)
# stack:
LINK_OPTIONS_gfortran :=-Wl,-undefined,dynamic_lookup
COMPILE_OPTIONS_gfortran :=-DDAMASKVERSION=\"${DAMASKVERSION}\"\
-xf95-cpp-input\
-ffree-line-length-132\
-fimplicit-none\
-fmodule-private\
-Wall\
-Wextra\
-Wcharacter-truncation\
-Wunderflow\
-Wsuggest-attribute=pure\
-Wsuggest-attribute=noreturn\
-Wconversion-extra\
-Wimplicit-procedure\
-Wno-unused-parameter
#-ffpe-summary=all only for newer gfortran
###################################################################################################
#COMPILE SWITCHES
#-shared
#-Wl,-undefined,dynamic_lookup:ensure to link against dynamic libraries
#-xf95-cpp-input: preprocessor
#-ffree-line-length-132: restrict line length to the standard 132 characters
#-ffpe-summary: print summary of floating point exeptions (‘invalid’, ‘zero’, ‘overflow’, ‘underflow’, ‘inexact’ and ‘denormal’)
#-fimplicit-none: assume "implicit-none" even if not present in source
#-fmodule-private: assume "private" even if not present in source
#-Wcharacter-truncation: warn if character expressions (strings) are truncated
#-Wunderflow: produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation
#-Wsuggest-attribute=pure:
#-Wsuggest-attribute=noreturn:
#-Wconversion-extra
#-Wimplicit-procedure
#-Wall: sets the following Fortran options:
# -Waliasing: warn about possible aliasing of dummy arguments. Specifically, it warns if the same actual argument is associated with a dummy argument with "INTENT(IN)" and a dummy argument with "INTENT(OUT)" in a call with an explicit interface.
# -Wampersand: checks if a character expression is continued proberly by an ampersand at the end of the line and at the beginning of the new line
# -Warray-bounds: checks if array reference is out of bounds at compile time. use -fcheck-bounds to also check during runtime
# -Wconversion: warn about implicit conversions between different type
# -Wsurprising: warn when "suspicious" code constructs are encountered. While technically legal these usually indicate that an error has been made.
# -Wc-binding-type:
# -Wintrinsics-std: only standard intrisics are available, e.g. "call flush(6)" will cause an error
# -Wno-tabs: do not allow tabs in source
# -Wintrinsic-shadow: warn if a user-defined procedure or module procedure has the same name as an intrinsic
# -Wline-truncation:
# -Wtarget-lifetime:
# -Wreal-q-constant: warn about real-literal-constants with 'q' exponent-letter
# -Wunused: a number of unused-xxx warnings
# these are general (non -Fortran options) implied by -Wall
# -Waddress
# -Warray-bounds (only with -O2)
# -Wc++11-compat
# -Wchar-subscripts
# -Wcomment
# -Wformat
# -Wmaybe-uninitialized
# -Wnonnull
# -Wparentheses
# -Wpointer-sign
# -Wreorder
# -Wreturn-type
# -Wsequence-point
# -Wstrict-aliasing
# -Wstrict-overflow=1
# -Wswitch
# -Wtrigraphs
# -Wuninitialized
# -Wunknown-pragmas
# -Wunused-function
# -Wunused-label
# -Wunused-value
# -Wunused-variable
# -Wvolatile-register-var
#-Wextra: sets the following Fortran options:
# -Wunuses-parameter:
# -Wcompare-reals:
# these are general (non -Fortran options) implied by -Wextra
# -Wclobbered
# -Wempty-body
# -Wignored-qualifiers
# -Wmissing-field-initializers
# -Woverride-init
# -Wsign-compare
# -Wtype-limits
# -Wuninitialized
# -Wunused-but-set-parameter (only with -Wunused or -Wall)
# -Wno-globals
###################################################################################################
#MORE OPTIONS FOR DEBUGGING DURING COMPILATION
#-Warray-temporarieswarnings: because we have many temporary arrays (performance issue?):
#-Wimplicit-interface: no interfaces for lapack routines
#-Wunsafe-loop-optimizations: warn if the loop cannot be optimized due to nontrivial assumptions.
#-Wstrict-overflow:
DEBUG_OPTIONS_gfortran :=-g\
-fbacktrace\
-fdump-core\
-fcheck=all\
-ffpe-trap=invalid,zero,overflow
###################################################################################################
#COMPILE SWITCHES FOR RUNTIME DEBUGGING
#-ffpe-trap=invalid,\ stop execution if floating point exception is detected (NaN is silent)
# zero,\
# overflow
#-fcheck=all: sets the following Fortran options:
#array-temps
#bounds
#do
#mem
#pointer
#recursion
###################################################################################################
#MORE OPTIONS FOR RUNTIME DEBUGGING
#-ffpe-trap=precision,\
# denormal, \
# underflow
ifeq "$(DEBUG)" "ON"
COMPILE_OPTIONS_$(F90) +=$(DEBUG_OPTIONS_$(F90))
LINK_OPTIONS_$(F90) +=$(DEBUG_OPTIONS_$(F90))
endif
LINK_OPTIONS_$(F90) += $(OPTIMIZATION_$(MAXOPTI)_$(F90))
PRECISION_ifort :=-real-size 64 -integer-size 32 -DFLOAT=8 -DINT=4
#-real-size 32: set precision to one of those 32/64/128 (= 4/8/16 bytes) for standard real (=8 for pReal)
#-integer-size 16: set precision to one of those 16/32/64 (= 2/4/8 bytes) for standard integer (=4 for pInt)
PRECISION_gfortran :=-fdefault-real-8 -fdefault-double-8 -DFLOAT=8 -DINT=4
#-fdefault-real-8: set precision to 8 bytes for standard real (=8 for pReal). Will set size of double to 16 bytes as long as -fdefault-double-8 is not set
#-fdefault-double-8: set precision to 8 bytes for double real, would be 16 bytes because -fdefault-real-8 is used
#-fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4)
###################################################################################################
COMPILE =$(OPENMP_FLAG_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(OPTI)_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(INCLUDE_DIRS) $(PRECISION_$(F90))
COMPILE_MAXOPTI =$(OPENMP_FLAG_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(INCLUDE_DIRS) $(PRECISION_$(F90))
###################################################################################################
SOURCE_FILES = \
source_thermal_dissipation.o source_thermal_externalheat.o \
source_damage_isoBrittle.o source_damage_isoDuctile.o source_damage_anisoBrittle.o source_damage_anisoDuctile.o \
source_vacancy_phenoplasticity.o source_vacancy_irradiation.o source_vacancy_thermalfluc.o
KINEMATICS_FILES = \
kinematics_cleavage_opening.o kinematics_slipplane_opening.o \
kinematics_thermal_expansion.o \
kinematics_vacancy_strain.o kinematics_hydrogen_strain.o
PLASTIC_FILES = \
plastic_dislotwin.o plastic_disloUCLA.o plastic_isotropic.o plastic_j2.o \
plastic_phenopowerlaw.o plastic_titanmod.o plastic_nonlocal.o plastic_none.o \
plastic_phenoplus.o
THERMAL_FILES = \
thermal_isothermal.o thermal_adiabatic.o thermal_conduction.o
DAMAGE_FILES = \
damage_none.o damage_local.o damage_nonlocal.o
VACANCYFLUX_FILES = \
vacancyflux_isoconc.o vacancyflux_isochempot.o vacancyflux_cahnhilliard.o
POROSITY_FILES = \
porosity_none.o porosity_phasefield.o
HYDROGENFLUX_FILES = \
hydrogenflux_isoconc.o hydrogenflux_cahnhilliard.o
HOMOGENIZATION_FILES = \
homogenization_RGC.o homogenization_isostrain.o homogenization_none.o
#####################
# Spectral Solver
#####################
DAMASK_spectral.exe: IGNORE := \#
DAMASK_spectral.exe: COMPILE += -DSpectral
DAMASK_spectral.exe: COMPILE_MAXOPTI += -DSpectral
DAMASK_spectral.exe: MESHNAME := mesh.f90
DAMASK_spectral.exe: INTERFACENAME := spectral_interface.f90
DAMASK_spectral.o: IGNORE := \#
DAMASK_spectral.o: COMPILE += -DSpectral
DAMASK_spectral.o: COMPILE_MAXOPTI += -DSpectral
DAMASK_spectral.o: MESHNAME := mesh.f90
DAMASK_spectral.o: INTERFACENAME := spectral_interface.f90
SPECTRAL_SOLVER_FILES = spectral_mech_AL.o spectral_mech_Basic.o spectral_mech_Polarisation.o \
spectral_thermal.o spectral_damage.o
SPECTRAL_FILES = prec.o DAMASK_interface.o IO.o libs.o numerics.o debug.o math.o damask_hdf5.o \
FEsolving.o mesh.o material.o lattice.o \
$(SOURCE_FILES) $(KINEMATICS_FILES) $(PLASTIC_FILES) constitutive.o \
crystallite.o \
$(THERMAL_FILES) $(DAMAGE_FILES) $(VACANCYFLUX_FILES) $(HYDROGENFLUX_FILES) $(POROSITY_FILES) \
$(HOMOGENIZATION_FILES) homogenization.o \
CPFEM2.o \
spectral_utilities.o \
$(SPECTRAL_SOLVER_FILES)
DAMASK_spectral.exe: DAMASK_spectral.o \
$(SPECTRAL_FILES)
$(PREFIX) $(LINKERNAME) $(OPENMP_FLAG_$(F90)) $(LINK_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) \
-o DAMASK_spectral.exe DAMASK_spectral.o \
$(SPECTRAL_FILES) $(LIBRARIES) $(HDFLIBS) $(HDFLIBZ) $(SUFFIX)
DAMASK_spectral.o: DAMASK_spectral.f90 \
$(SPECTRAL_SOLVER_FILES)
$(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) -c DAMASK_spectral.f90 $(SUFFIX)
spectral_mech_AL.o: spectral_mech_AL.f90 \
spectral_utilities.o
spectral_mech_Polarisation.o: spectral_mech_Polarisation.f90 \
spectral_utilities.o
spectral_mech_Basic.o: spectral_mech_Basic.f90 \
spectral_utilities.o
spectral_thermal.o: spectral_thermal.f90 \
spectral_utilities.o
spectral_damage.o: spectral_damage.f90 \
spectral_utilities.o
spectral_utilities.o: spectral_utilities.f90 \
CPFEM2.o
#####################
# FEM Solver
#####################
VPATH := ../private/FEM/code
DAMASK_FEM.exe: COMPILE += -DFEM
DAMASK_FEM.exe: COMPILE_MAXOPTI += -DFEM
DAMASK_FEM.exe: MESHNAME := ../private/FEM/code/meshFEM.f90
DAMASK_FEM.exe: INTERFACENAME := ../private/FEM/code/DAMASK_FEM_interface.f90
DAMASK_FEM.exe: INCLUDE_DIRS += -I./
FEM_SOLVER_FILES = FEM_mech.o FEM_thermal.o FEM_damage.o FEM_vacancyflux.o FEM_porosity.o FEM_hydrogenflux.o
FEM_FILES = prec.o DAMASK_interface.o FEZoo.o IO.o libs.o numerics.o debug.o math.o \
FEsolving.o mesh.o material.o lattice.o \
$(SOURCE_FILES) $(KINEMATICS_FILES) $(PLASTIC_FILES) constitutive.o \
crystallite.o \
$(THERMAL_FILES) $(DAMAGE_FILES) $(VACANCYFLUX_FILES) $(HYDROGENFLUX_FILES) $(POROSITY_FILES) \
$(HOMOGENIZATION_FILES) homogenization.o \
CPFEM.o \
FEM_utilities.o $(FEM_SOLVER_FILES)
DAMASK_FEM.exe: DAMASK_FEM_driver.o
$(PREFIX) $(LINKERNAME) $(OPENMP_FLAG_$(F90)) $(LINK_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) \
-o DAMASK_FEM.exe DAMASK_FEM_driver.o \
$(FEM_FILES) $(LIBRARIES) $(HDFLIBS) $(HDFLIBZ) $(SUFFIX)
DAMASK_FEM_driver.o: DAMASK_FEM_driver.f90 $(FEM_SOLVER_FILES)
$(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) -c ../private/FEM/code/DAMASK_FEM_driver.f90 $(SUFFIX)
FEM_mech.o: FEM_mech.f90 \
FEM_utilities.o
FEM_thermal.o: FEM_thermal.f90 \
FEM_utilities.o
FEM_damage.o: FEM_damage.f90 \
FEM_utilities.o
FEM_vacancyflux.o: FEM_vacancyflux.f90 \
FEM_utilities.o
FEM_porosity.o: FEM_porosity.f90 \
FEM_utilities.o
FEM_hydrogenflux.o: FEM_hydrogenflux.f90 \
FEM_utilities.o
FEM_utilities.o: FEM_utilities.f90 \
CPFEM.o
FEZoo.o: $(wildcard FEZoo.f90) \
IO.o
$(IGNORE) $(PREFIX) $(COMPILERNAME) $(COMPILE) -c ../private/FEM/code/FEZoo.f90 $(SUFFIX)
touch FEZoo.o
CPFEM.o: CPFEM.f90 \
homogenization.o
CPFEM2.o: CPFEM2.f90 \
homogenization.o
homogenization.o: homogenization.f90 \
$(THERMAL_FILES) \
$(DAMAGE_FILES) \
$(VACANCYFLUX_FILES) \
$(POROSITY_FILES) \
$(HYDROGENFLUX_FILES) \
$(HOMOGENIZATION_FILES)
thermal_isothermal.o: thermal_isothermal.f90 \
crystallite.o
thermal_adiabatic.o: thermal_adiabatic.f90 \
crystallite.o
thermal_conduction.o: thermal_conduction.f90 \
crystallite.o
damage_none.o: damage_none.f90 \
crystallite.o
damage_local.o: damage_local.f90 \
crystallite.o
damage_nonlocal.o: damage_nonlocal.f90 \
crystallite.o
thermal_conduction.o: thermal_conduction.f90 \
crystallite.o
vacancyflux_isoconc.o: vacancyflux_isoconc.f90 \
crystallite.o
vacancyflux_isochempot.o: vacancyflux_isochempot.f90 \
crystallite.o
vacancyflux_cahnhilliard.o: vacancyflux_cahnhilliard.f90 \
crystallite.o
porosity_none.o: porosity_none.f90 \
crystallite.o
porosity_phasefield.o: porosity_phasefield.f90 \
crystallite.o
hydrogenflux_isoconc.o: hydrogenflux_isoconc.f90 \
crystallite.o
hydrogenflux_cahnhilliard.o: hydrogenflux_cahnhilliard.f90 \
crystallite.o
homogenization_RGC.o: homogenization_RGC.f90 \
crystallite.o
homogenization_isostrain.o: homogenization_isostrain.f90 \
crystallite.o
homogenization_none.o: homogenization_none.f90 \
crystallite.o
crystallite.o: crystallite.f90 \
constitutive.o
constitutive.o: constitutive.f90 \
$(SOURCE_FILES) \
$(KINEMATICS_FILES) \
$(PLASTIC_FILES)
source_thermal_dissipation.o: source_thermal_dissipation.f90 \
lattice.o
source_thermal_externalheat.o: source_thermal_externalheat.f90 \
lattice.o
source_damage_isoBrittle.o: source_damage_isoBrittle.f90 \
lattice.o
source_damage_isoDuctile.o: source_damage_isoDuctile.f90 \
lattice.o
source_damage_anisoBrittle.o: source_damage_anisoBrittle.f90 \
lattice.o
source_damage_anisoDuctile.o: source_damage_anisoDuctile.f90 \
lattice.o
source_vacancy_phenoplasticity.o: source_vacancy_phenoplasticity.f90 \
lattice.o
source_vacancy_irradiation.o: source_vacancy_irradiation.f90 \
lattice.o
source_vacancy_thermalfluc.o: source_vacancy_thermalfluc.f90 \
lattice.o
kinematics_cleavage_opening.o: kinematics_cleavage_opening.f90 \
lattice.o
kinematics_slipplane_opening.o: kinematics_slipplane_opening.f90 \
lattice.o
kinematics_thermal_expansion.o: kinematics_thermal_expansion.f90 \
lattice.o
kinematics_vacancy_strain.o: kinematics_vacancy_strain.f90 \
lattice.o
kinematics_hydrogen_strain.o: kinematics_hydrogen_strain.f90 \
lattice.o
plastic_nonlocal.o: plastic_nonlocal.f90 \
lattice.o
plastic_titanmod.o: plastic_titanmod.f90 \
lattice.o
plastic_disloUCLA.o: plastic_disloUCLA.f90 \
lattice.o
plastic_dislotwin.o: plastic_dislotwin.f90 \
lattice.o
plastic_phenopowerlaw.o: plastic_phenopowerlaw.f90 \
lattice.o
plastic_phenoplus.o: plastic_phenoplus.f90 \
lattice.o
plastic_isotropic.o: plastic_isotropic.f90 \
lattice.o
plastic_j2.o: plastic_j2.f90 \
lattice.o
plastic_none.o: plastic_none.f90 \
lattice.o
ifeq "$(F90)" "gfortran"
lattice.o: lattice.f90 \
material.o
$(PREFIX) $(COMPILERNAME) $(COMPILE) -ffree-line-length-240 -c lattice.f90 $(SUFFIX)
# long lines for interaction matrix
else
lattice.o: lattice.f90 \
material.o
endif
material.o: material.f90 \
mesh.o
mesh.o: mesh.f90 \
$(wildcard meshFEM.f90) \
FEsolving.o \
math.o \
FEZoo.o
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(MESHNAME) -o mesh.o $(SUFFIX)
FEsolving.o: FEsolving.f90 \
debug.o
math.o: math.f90 \
debug.o
debug.o: debug.f90 \
numerics.o
numerics.o: numerics.f90 \
libs.o
libs.o: libs.f90 \
IO.o
damask_hdf5.o: damask_hdf5.f90 \
prec.o \
IO.o
$(PREFIX) $(COMPILERNAME) $(HDFLIBS) $(HDFLIBZ) -c damask_hdf5.f90 $(SUFFIX) -lm
IO.o: IO.f90 \
DAMASK_interface.o
ifeq "$(F90)" "gfortran"
DAMASK_interface.o: spectral_interface.f90 \
$(wildcard DAMASK_FEM_interface.f90) \
prec.o
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -fall-intrinsics -o DAMASK_interface.o $(SUFFIX)
#-fall-intrinsics: all intrinsic procedures (including the GNU-specific extensions) are accepted. -Wintrinsics-std will be ignored
# and no user-defined procedure with the same name as any intrinsic will be called except when it is explicitly declared external
# --> allows the use of 'getcwd'
prec.o: prec.f90
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c prec.f90 -fno-range-check -fall-intrinsics -fno-fast-math $(SUFFIX)
# fno-range-check: Disable range checking on results of simplification of constant expressions during compilation
# --> allows the definition of DAMASK_NaN
#-fall-intrinsics: all intrinsic procedures (including the GNU-specific extensions) are accepted. -Wintrinsics-std will be ignored
# and no user-defined procedure with the same name as any intrinsic will be called except when it is explicitly declared external
# --> allows the use of 'isnan'
#-fno-fast-math:
# --> otherwise, when setting -ffast-math, isnan always evaluates to false (I would call it a bug)
else
DAMASK_interface.o: spectral_interface.f90 \
$(wildcard DAMASK_FEM_interface.f90) \
prec.o
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -diag-remark 7410 -stand none -warn nostderrors -o DAMASK_interface.o $(SUFFIX)
# -diag-disable 7410 should disable warning about directory statement in inquire function, but does not work. hence the other 2 statements
prec.o: prec.f90
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c prec.f90 $(SUFFIX)
endif
%.o : %.f90
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c $< $(SUFFIX)
.PHONY: tidy
tidy:
@rm -rf *.o
@rm -rf *.mod
@rm -rf *.inst.f90 # for instrumentation
@rm -rf *.pomp.f90 # for instrumentation
@rm -rf *.pp.f90 # for instrumentation
@rm -rf *.pdb # for instrumnentation
@rm -rf *.opari.inc # for instrumnentation
.PHONY: cleanDAMASK
cleanDAMASK:
@rm -rf *.exe
@rm -rf *.marc
@rm -rf *.o
@rm -rf *.mod
@rm -rf *.inst.f90 # for instrumentation
@rm -rf *.pomp.f90 # for instrumentation
@rm -rf *.pp.f90 # for instrumentation
@rm -rf *.pdb # for instrumentation
@rm -rf *.opari.inc # for instrumentation
.PHONY: help
help:
F90="$(F90)"
COMPILERNAME="$(COMPILERNAME)"
COMPILEROUT="$(COMPILEROUT)"

59
src/commercialFEM_fileList.f90 Normal file
View File

@ -0,0 +1,59 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief all DAMASK files without solver
!> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard
!--------------------------------------------------------------------------------------------------
#include "IO.f90"
#include "libs.f90"
#include "numerics.f90"
#include "debug.f90"
#include "math.f90"
#include "FEsolving.f90"
#include "mesh.f90"
#include "material.f90"
#include "lattice.f90"
#include "source_thermal_dissipation.f90"
#include "source_thermal_externalheat.f90"
#include "source_damage_isoBrittle.f90"
#include "source_damage_isoDuctile.f90"
#include "source_damage_anisoBrittle.f90"
#include "source_damage_anisoDuctile.f90"
#include "source_vacancy_phenoplasticity.f90"
#include "source_vacancy_irradiation.f90"
#include "source_vacancy_thermalfluc.f90"
#include "kinematics_cleavage_opening.f90"
#include "kinematics_slipplane_opening.f90"
#include "kinematics_thermal_expansion.f90"
#include "kinematics_vacancy_strain.f90"
#include "kinematics_hydrogen_strain.f90"
#include "plastic_none.f90"
#include "plastic_isotropic.f90"
#include "plastic_j2.f90"
#include "plastic_phenopowerlaw.f90"
#include "plastic_phenoplus.f90"
#include "plastic_titanmod.f90"
#include "plastic_dislotwin.f90"
#include "plastic_disloUCLA.f90"
#include "plastic_nonlocal.f90"
#include "constitutive.f90"
#include "crystallite.f90"
#include "homogenization_none.f90"
#include "homogenization_isostrain.f90"
#include "homogenization_RGC.f90"
#include "thermal_isothermal.f90"
#include "thermal_adiabatic.f90"
#include "thermal_conduction.f90"
#include "damage_none.f90"
#include "damage_local.f90"
#include "damage_nonlocal.f90"
#include "vacancyflux_isoconc.f90"
#include "vacancyflux_isochempot.f90"
#include "vacancyflux_cahnhilliard.f90"
#include "porosity_none.f90"
#include "porosity_phasefield.f90"
#include "hydrogenflux_isoconc.f90"
#include "hydrogenflux_cahnhilliard.f90"
#include "homogenization.f90"
#include "CPFEM.f90"

13
src/compilation_info.f90 Normal file
View File

@ -0,0 +1,13 @@
!##############################################################
!$Id$
#ifdef __GFORTRAN__
write(6,*) 'Compiled with ', compiler_version() !not supported by and ifort <= 15 (and old gfortran)
write(6,*) 'With options ', compiler_options()
#endif
#ifdef __INTEL_COMPILER
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,&
', build date ', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,*)
flush(6)

1226
src/constitutive.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

15
src/core_quit.f90 Normal file
View File

@ -0,0 +1,15 @@
!##################################################################################################
! $Id$
!##################################################################################################
!********************************************************************
! quit subroutine to satisfy IO_error for core module
!
!********************************************************************
subroutine quit(stop_id)
use prec, only: &
pInt
implicit none
integer(pInt), intent(in) :: stop_id
end subroutine

4228
src/crystallite.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

327
src/damage_local.f90 Normal file
View File

@ -0,0 +1,327 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for locally evolving damage field
!--------------------------------------------------------------------------------------------------
module damage_local
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
damage_local_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
damage_local_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
damage_local_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
damage_local_Noutput !< number of outputs per instance of this damage
enum, bind(c)
enumerator :: undefined_ID, &
damage_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
damage_local_outputID !< ID of each post result output
public :: &
damage_local_init, &
damage_local_updateState, &
damage_local_postResults
private :: &
damage_local_getSourceAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine damage_local_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
damage_type, &
damage_typeInstance, &
homogenization_Noutput, &
DAMAGE_local_label, &
DAMAGE_local_ID, &
material_homog, &
mappingHomogenization, &
damageState, &
damageMapping, &
damage, &
damage_initialPhi, &
material_partHomogenization
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,homog,instance,o
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(damage_local_sizePostResults(maxNinstance), source=0_pInt)
allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance))
damage_local_output = ''
allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(damage_local_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
homog = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
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

60
src/damage_none.f90 Normal file
View File

@ -0,0 +1,60 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for constant damage field
!--------------------------------------------------------------------------------------------------
module damage_none
implicit none
private
public :: &
damage_none_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine damage_none_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: &
pInt
use IO, only: &
IO_timeStamp
use material
use numerics, only: &
worldrank
implicit none
integer(pInt) :: &
homog, &
NofMyHomog
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (damage_type(homog) == DAMAGE_none_ID) then
NofMyHomog = count(material_homog == homog)
damageState(homog)%sizeState = 0_pInt
damageState(homog)%sizePostResults = 0_pInt
allocate(damageState(homog)%state0 (0_pInt,NofMyHomog))
allocate(damageState(homog)%subState0(0_pInt,NofMyHomog))
allocate(damageState(homog)%state (0_pInt,NofMyHomog))
deallocate(damage(homog)%p)
allocate (damage(homog)%p(1), source=damage_initialPhi(homog))
endif myhomog
enddo initializeInstances
end subroutine damage_none_init
end module damage_none

380
src/damage_nonlocal.f90 Normal file
View File

@ -0,0 +1,380 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for non-locally evolving damage field
!> @details to be done
!--------------------------------------------------------------------------------------------------
module damage_nonlocal
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
damage_nonlocal_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
damage_nonlocal_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
damage_nonlocal_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
damage_nonlocal_Noutput !< number of outputs per instance of this damage
enum, bind(c)
enumerator :: undefined_ID, &
damage_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
damage_nonlocal_outputID !< ID of each post result output
public :: &
damage_nonlocal_init, &
damage_nonlocal_getSourceAndItsTangent, &
damage_nonlocal_getDiffusion33, &
damage_nonlocal_getMobility, &
damage_nonlocal_putNonLocalDamage, &
damage_nonlocal_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine damage_nonlocal_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
damage_type, &
damage_typeInstance, &
homogenization_Noutput, &
DAMAGE_nonlocal_label, &
DAMAGE_nonlocal_ID, &
material_homog, &
mappingHomogenization, &
damageState, &
damageMapping, &
damage, &
damage_initialPhi, &
material_partHomogenization
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(damage_nonlocal_sizePostResults(maxNinstance), source=0_pInt)
allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance))
damage_nonlocal_output = ''
allocate(damage_nonlocal_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(damage_nonlocal_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
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

126
src/damask.core.pyf Normal file
View File

@ -0,0 +1,126 @@
! $Id$
! -*- f90 -*-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Note: the syntax of this file is case sensitive.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This file was auto-generated with f2py (version:2_5972).
! See http://cens.ioc.ee/projects/f2py2e/
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The auto-generated file is quite heavily corrected
! For modifying, notice the following hints:
! - if the dimension of an array depend on a array that is itself an input, use the C-Syntax: (1) becomes [0] etc.
! - be sure that the precision defined is integer, real*8, and complex*16
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
python module core ! in
interface ! in :core
module prec
subroutine prec_init
end subroutine prec_init
end module prec
module damask_interface ! in :damask_interface:DAMASK_spectral_interface.f90
subroutine DAMASK_interface_init(loadcaseParameterIn,geometryParameterIn) ! in :damask_interface:DAMASK_spectral_interface.f90
character(len=1024), intent(in) :: loadcaseParameterIn
character(len=1024), intent(in) :: geometryParameterIn
end subroutine DAMASK_interface_init
end module damask_interface
module io
subroutine IO_init
end subroutine IO_init
end module io
module numerics
subroutine numerics_init
end subroutine numerics_init
end module numerics
module debug
subroutine debug_init
end subroutine debug_init
end module debug
module math ! in :math:math.f90
subroutine math_init
end subroutine math_init
function math_tensorAvg(field) ! in :math:math.f90
! input variables
real*8 dimension(:,:,:,:,:), intent(in), :: field
! function definition
real*8 dimension(3,3), :: math_tensorAvg
end function math_tensorAvg
end module math
module fesolving
subroutine FE_init
end subroutine FE_init
end module fesolving
module mesh ! in :mesh:mesh.f90
subroutine mesh_init(ip,element)
integer, parameter :: ip = 1
integer, parameter :: element = 1
end subroutine mesh_init
function mesh_nodesAroundCentres(gDim,Favg,centres) ! in :mesh:mesh.f90
real*8, dimension(:,:,:,:), intent(in) :: centres
real*8, dimension(3), intent(in) :: gDim
real*8, dimension(3,3), intent(in) :: Favg
real*8, dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1), depend(centres) :: mesh_nodesAroundCentres
real*8, dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1), depend(centres) :: wrappedCentres
end function mesh_nodesAroundCentres
function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) ! in :mesh:mesh.f90
real*8, dimension(:,:,:,:,:), intent(in) :: F
real*8, dimension(3), intent(in) :: gDim
real*8, dimension(3,3), intent(in), optional :: FavgIn = -1.0
real*8, dimension(3), intent(in), optional :: scalingIn = -1.0
real*8, dimension(3,size(F,3),size(F,4),size(F,5)), depend(F) :: mesh_deformedCoordsFFT
end function mesh_deformedCoordsFFT
function mesh_volumeMismatch(gDim,F,nodes) ! in :mesh:mesh.f90
real*8, dimension(:,:,:,:,:), intent(in) :: F
real*8, dimension(:,:,:,:), intent(in) :: nodes
real*8, dimension(3), intent(in) :: gDim
real*8, dimension(size(F,3),size(F,4),size(F,5)), depend(F) :: mesh_volumeMismatch
end function mesh_volumeMismatch
function mesh_shapeMismatch(gDim,F,nodes,centres) ! in :mesh:mesh.f90
real*8, dimension(:,:,:,:,:), intent(in) :: F
real*8, dimension(:,:,:,:), intent(in) :: nodes
real*8, dimension(:,:,:,:), intent(in) :: centres
real*8, dimension(3), intent(in) :: gDim
real*8, dimension(size(F,3),size(F,4),size(F,5)), depend(F) :: mesh_shapeMismatch
end function mesh_shapeMismatch
function mesh_init_postprocessing(filepath) ! in :mesh:mesh.f90
character(len=*), intent(in) :: filepath
end function mesh_init_postprocessing
function mesh_build_cellnodes(nodes,Ncellnodes) ! in :mesh:mesh.f90
integer, intent(in) :: Ncellnodes
real*8, dimension(3,:), intent(in) :: nodes
real*8, dimension(3,Ncellnodes), depend(Ncellnodes) :: mesh_build_cellnodes
end function mesh_build_cellnodes
function mesh_get_Ncellnodes() ! in :mesh:mesh.f90
integer :: mesh_get_Ncellnodes
end function mesh_get_Ncellnodes
function mesh_get_unitlength() ! in :mesh:mesh.f90
real*8 :: mesh_get_unitlength
end function mesh_get_unitlength
function mesh_get_nodeAtIP(elemtypeFE,ip) ! in :mesh:mesh.f90
character(len=*), intent(in) :: elemtypeFE
integer, intent(in) :: ip
integer :: mesh_get_nodeAtIP
end function mesh_get_nodeAtIP
end module mesh
end interface
end python module core

16
src/damask_hdf5.f90 Normal file
View File

@ -0,0 +1,16 @@
module HDF5_io
use prec
use IO
use hdf5
contains
subroutine HDF5_init(filename, total_inc, total_time)
integer(pInt), intent(in) :: total_inc
real(pReal), intent(in) :: total_time
write(6,*) 'pretend to write something'
end subroutine HDF5_init
end module HDF5_io

476
src/debug.f90 Normal file
View File

@ -0,0 +1,476 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Reading in and interpretating the debugging settings for the various modules
!--------------------------------------------------------------------------------------------------
module debug
use prec, only: &
pInt, &
pReal, &
pLongInt
implicit none
private
integer(pInt), parameter, public :: &
debug_LEVELSELECTIVE = 2_pInt**0_pInt, &
debug_LEVELBASIC = 2_pInt**1_pInt, &
debug_LEVELEXTENSIVE = 2_pInt**2_pInt
integer(pInt), parameter, private :: &
debug_MAXGENERAL = debug_LEVELEXTENSIVE ! must be set to the last bitcode used by (potentially) all debug types
integer(pInt), parameter, public :: &
debug_SPECTRALRESTART = debug_MAXGENERAL*2_pInt**1_pInt, &
debug_SPECTRALFFTW = debug_MAXGENERAL*2_pInt**2_pInt, &
debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2_pInt**3_pInt, &
debug_SPECTRALROTATION = debug_MAXGENERAL*2_pInt**4_pInt, &
debug_SPECTRALPETSC = debug_MAXGENERAL*2_pInt**5_pInt
integer(pInt), parameter, public :: &
debug_DEBUG = 1_pInt, &
debug_MATH = 2_pInt, &
debug_FESOLVING = 3_pInt, &
debug_MESH = 4_pInt, & !< stores debug level for mesh part of DAMASK bitwise coded
debug_MATERIAL = 5_pInt, & !< stores debug level for material part of DAMASK bitwise coded
debug_LATTICE = 6_pInt, & !< stores debug level for lattice part of DAMASK bitwise coded
debug_CONSTITUTIVE = 7_pInt, & !< stores debug level for constitutive part of DAMASK bitwise coded
debug_CRYSTALLITE = 8_pInt, &
debug_HOMOGENIZATION = 9_pInt, &
debug_CPFEM = 10_pInt, &
debug_SPECTRAL = 11_pInt, &
debug_MARC = 12_pInt, &
debug_ABAQUS = 13_pInt
integer(pInt), parameter, private :: &
debug_MAXNTYPE = debug_ABAQUS !< must be set to the maximum defined debug type
integer(pInt),protected, dimension(debug_maxNtype+2_pInt), public :: & ! specific ones, and 2 for "all" and "other"
debug_level = 0_pInt
integer(pInt), public :: &
debug_cumLpCalls = 0_pInt, & !< total number of calls to LpAndItsTangent
debug_cumDeltaStateCalls = 0_pInt, & !< total number of calls to deltaState
debug_cumDotStateCalls = 0_pInt !< total number of calls to dotState
integer(pInt), protected, public :: &
debug_e = 1_pInt, &
debug_i = 1_pInt, &
debug_g = 1_pInt
integer(pLongInt), public :: &
debug_cumLpTicks = 0_pLongInt, & !< total cpu ticks spent in LpAndItsTangent
debug_cumDeltaStateTicks = 0_pLongInt, & !< total cpu ticks spent in deltaState
debug_cumDotStateTicks = 0_pLongInt !< total cpu ticks spent in dotState
integer(pInt), dimension(2), public :: &
debug_stressMaxLocation = 0_pInt, &
debug_stressMinLocation = 0_pInt, &
debug_jacobianMaxLocation = 0_pInt, &
debug_jacobianMinLocation = 0_pInt
integer(pInt), dimension(:), allocatable, public :: &
debug_CrystalliteLoopDistribution, & !< distribution of crystallite cutbacks
debug_MaterialpointStateLoopDistribution, &
debug_MaterialpointLoopDistribution
integer(pInt), dimension(:,:), allocatable, public :: &
debug_StressLoopLiDistribution, & !< distribution of stress iterations until convergence
debug_StressLoopLpDistribution, & !< distribution of stress iterations until convergence
debug_StateLoopDistribution !< distribution of state iterations until convergence
real(pReal), public :: &
debug_stressMax = -huge(1.0_pReal), &
debug_stressMin = huge(1.0_pReal), &
debug_jacobianMax = -huge(1.0_pReal), &
debug_jacobianMin = huge(1.0_pReal)
character(len=64), parameter, private :: &
debug_CONFIGFILE = 'debug.config' !< name of configuration file
#ifdef PETSc
character(len=1024), parameter, public :: &
PETSCDEBUG = ' -snes_view -snes_monitor '
#endif
public :: debug_init, &
debug_reset, &
debug_info
contains
!--------------------------------------------------------------------------------------------------
!> @brief reads in parameters from debug.config and allocates arrays
!--------------------------------------------------------------------------------------------------
subroutine debug_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use numerics, only: &
worldrank, &
nStress, &
nState, &
nCryst, &
nMPstate, &
nHomog
use IO, only: &
IO_read, &
IO_error, &
IO_open_file_stat, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_lc, &
IO_floatValue, &
IO_intValue, &
IO_timeStamp, &
IO_EOF
implicit none
integer(pInt), parameter :: FILEUNIT = 300_pInt
integer(pInt) :: i, what
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: tag, line
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- debug init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
if (allocated(debug_StressLoopLpDistribution)) &
deallocate(debug_StressLoopLpDistribution)
allocate(debug_StressLoopLpDistribution(nStress+1,2))
debug_StressLoopLpDistribution = 0_pInt
if (allocated(debug_StressLoopLiDistribution)) &
deallocate(debug_StressLoopLiDistribution)
allocate(debug_StressLoopLiDistribution(nStress+1,2))
debug_StressLoopLiDistribution = 0_pInt
if (allocated(debug_StateLoopDistribution)) &
deallocate(debug_StateLoopDistribution)
allocate(debug_StateLoopDistribution(nState+1,2))
debug_StateLoopDistribution = 0_pInt
if (allocated(debug_CrystalliteLoopDistribution)) &
deallocate(debug_CrystalliteLoopDistribution)
allocate(debug_CrystalliteLoopDistribution(nCryst+1))
debug_CrystalliteLoopDistribution = 0_pInt
if (allocated(debug_MaterialpointStateLoopDistribution)) &
deallocate(debug_MaterialpointStateLoopDistribution)
allocate(debug_MaterialpointStateLoopDistribution(nMPstate))
debug_MaterialpointStateLoopDistribution = 0_pInt
if (allocated(debug_MaterialpointLoopDistribution)) &
deallocate(debug_MaterialpointLoopDistribution)
allocate(debug_MaterialpointLoopDistribution(nHomog+1))
debug_MaterialpointLoopDistribution = 0_pInt
!--------------------------------------------------------------------------------------------------
! try to open the config file
line = ''
fileExists: if(IO_open_file_stat(FILEUNIT,debug_configFile)) then
do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(FILEUNIT)
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('element','e','el')
debug_e = IO_intValue(line,chunkPos,2_pInt)
case ('integrationpoint','i','ip')
debug_i = IO_intValue(line,chunkPos,2_pInt)
case ('grain','g','gr')
debug_g = IO_intValue(line,chunkPos,2_pInt)
end select
what = 0_pInt
select case(tag)
case ('debug')
what = debug_DEBUG
case ('math')
what = debug_MATH
case ('fesolving', 'fe')
what = debug_FESOLVING
case ('mesh')
what = debug_MESH
case ('material')
what = debug_MATERIAL
case ('lattice')
what = debug_LATTICE
case ('constitutive')
what = debug_CONSTITUTIVE
case ('crystallite')
what = debug_CRYSTALLITE
case ('homogenization')
what = debug_HOMOGENIZATION
case ('cpfem')
what = debug_CPFEM
case ('spectral')
what = debug_SPECTRAL
case ('marc')
what = debug_MARC
case ('abaqus')
what = debug_ABAQUS
case ('all')
what = debug_MAXNTYPE + 1_pInt
case ('other')
what = debug_MAXNTYPE + 2_pInt
end select
if (what /= 0) then
do i = 2_pInt, chunkPos(1)
select case(IO_lc(IO_stringValue(line,chunkPos,i)))
case('basic')
debug_level(what) = ior(debug_level(what), debug_LEVELBASIC)
case('extensive')
debug_level(what) = ior(debug_level(what), debug_LEVELEXTENSIVE)
case('selective')
debug_level(what) = ior(debug_level(what), debug_LEVELSELECTIVE)
case('restart')
debug_level(what) = ior(debug_level(what), debug_SPECTRALRESTART)
case('fft','fftw')
debug_level(what) = ior(debug_level(what), debug_SPECTRALFFTW)
case('divergence')
debug_level(what) = ior(debug_level(what), debug_SPECTRALDIVERGENCE)
case('rotation')
debug_level(what) = ior(debug_level(what), debug_SPECTRALROTATION)
case('petsc')
debug_level(what) = ior(debug_level(what), debug_SPECTRALPETSC)
end select
enddo
endif
enddo
close(FILEUNIT)
do i = 1_pInt, debug_maxNtype
if (debug_level(i) == 0) &
debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 2_pInt)) ! fill undefined debug types with levels specified by "other"
debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 1_pInt)) ! fill all debug types with levels specified by "all"
enddo
if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) &
write(6,'(a,/)') ' using values from config file'
else fileExists
if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) &
write(6,'(a,/)') ' using standard values'
endif fileExists
!--------------------------------------------------------------------------------------------------
! output switched on (debug level for debug must be extensive)
if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then
do i = 1_pInt, debug_MAXNTYPE
select case(i)
case (debug_DEBUG)
tag = ' Debug'
case (debug_MATH)
tag = ' Math'
case (debug_FESOLVING)
tag = ' FEsolving'
case (debug_MESH)
tag = ' Mesh'
case (debug_MATERIAL)
tag = ' Material'
case (debug_LATTICE)
tag = ' Lattice'
case (debug_CONSTITUTIVE)
tag = ' Constitutive'
case (debug_CRYSTALLITE)
tag = ' Crystallite'
case (debug_HOMOGENIZATION)
tag = ' Homogenizaiton'
case (debug_CPFEM)
tag = ' CPFEM'
case (debug_SPECTRAL)
tag = ' Spectral solver'
case (debug_MARC)
tag = ' MSC.MARC FEM solver'
case (debug_ABAQUS)
tag = ' ABAQUS FEM solver'
end select
if(debug_level(i) /= 0) then
write(6,'(3a)') ' debug level for ', trim(tag), ':'
if(iand(debug_level(i),debug_LEVELBASIC) /= 0) write(6,'(a)') ' basic'
if(iand(debug_level(i),debug_LEVELEXTENSIVE) /= 0) write(6,'(a)') ' extensive'
if(iand(debug_level(i),debug_LEVELSELECTIVE) /= 0) then
write(6,'(a)') ' selective on:'
write(6,'(a24,1x,i8)') ' element: ',debug_e
write(6,'(a24,1x,i8)') ' ip: ',debug_i
write(6,'(a24,1x,i8)') ' grain: ',debug_g
endif
if(iand(debug_level(i),debug_SPECTRALRESTART) /= 0) write(6,'(a)') ' restart'
if(iand(debug_level(i),debug_SPECTRALFFTW) /= 0) write(6,'(a)') ' FFTW'
if(iand(debug_level(i),debug_SPECTRALDIVERGENCE)/= 0) write(6,'(a)') ' divergence'
if(iand(debug_level(i),debug_SPECTRALROTATION) /= 0) write(6,'(a)') ' rotation'
if(iand(debug_level(i),debug_SPECTRALPETSC) /= 0) write(6,'(a)') ' PETSc'
endif
enddo
endif
end subroutine debug_init
!--------------------------------------------------------------------------------------------------
!> @brief resets all debug values
!--------------------------------------------------------------------------------------------------
subroutine debug_reset
implicit none
debug_StressLoopLpDistribution = 0_pInt
debug_StressLoopLiDistribution = 0_pInt
debug_StateLoopDistribution = 0_pInt
debug_CrystalliteLoopDistribution = 0_pInt
debug_MaterialpointStateLoopDistribution = 0_pInt
debug_MaterialpointLoopDistribution = 0_pInt
debug_cumLpTicks = 0_pLongInt
debug_cumDeltaStateTicks = 0_pLongInt
debug_cumDotStateTicks = 0_pLongInt
debug_cumLpCalls = 0_pInt
debug_cumDeltaStateCalls = 0_pInt
debug_cumDotStateCalls = 0_pInt
debug_stressMaxLocation = 0_pInt
debug_stressMinLocation = 0_pInt
debug_jacobianMaxLocation = 0_pInt
debug_jacobianMinLocation = 0_pInt
debug_stressMax = -huge(1.0_pReal)
debug_stressMin = huge(1.0_pReal)
debug_jacobianMax = -huge(1.0_pReal)
debug_jacobianMin = huge(1.0_pReal)
end subroutine debug_reset
!--------------------------------------------------------------------------------------------------
!> @brief writes debug statements to standard out
!--------------------------------------------------------------------------------------------------
subroutine debug_info
use numerics, only: &
nStress, &
nState, &
nCryst, &
nMPstate, &
nHomog
implicit none
integer(pInt) :: j,integral
integer(pLongInt) :: tickrate
character(len=1) :: exceed
call system_clock(count_rate=tickrate)
!$OMP CRITICAL (write2out)
debugOutputCryst: if (iand(debug_level(debug_CRYSTALLITE),debug_LEVELBASIC) /= 0) then
write(6,'(/,a,/)') ' DEBUG Info (from previous cycle)'
write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls
if (debug_cumLpCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',&
real(debug_cumLpTicks,pReal)/real(tickrate,pReal)
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate*debug_cumLpCalls,pReal)
endif
write(6,'(/,a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls
if (debug_cumdotStateCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',&
real(debug_cumDotStateTicks,pReal)/real(tickrate,pReal)
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate*debug_cumDotStateCalls,pReal)
endif
write(6,'(/,a33,1x,i12)') 'total calls to collectDeltaState:',debug_cumDeltaStateCalls
if (debug_cumDeltaStateCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',&
real(debug_cumDeltaStateTicks,pReal)/real(tickrate,pReal)
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
real(debug_cumDeltaStateTicks,pReal)*1.0e6_pReal/real(tickrate*debug_cumDeltaStateCalls,pReal)
endif
integral = 0_pInt
write(6,'(3/,a)') 'distribution_StressLoopLp : stress stiffness'
do j=1_pInt,nStress+1_pInt
if (any(debug_StressLoopLpDistribution(j,:) /= 0_pInt )) then
integral = integral + j*(debug_StressLoopLpDistribution(j,1) + debug_StressLoopLpDistribution(j,2))
exceed = ' '
if (j > nStress) exceed = '+' ! last entry gets "+"
write(6,'(i25,a1,i10,1x,i10)') min(nStress,j),exceed,debug_StressLoopLpDistribution(j,1),&
debug_StressLoopLpDistribution(j,2)
endif
enddo
write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StressLoopLpDistribution(:,1)), &
sum(debug_StressLoopLpDistribution(:,2))
integral = 0_pInt
write(6,'(3/,a)') 'distribution_StressLoopLi : stress stiffness'
do j=1_pInt,nStress+1_pInt
if (any(debug_StressLoopLiDistribution(j,:) /= 0_pInt )) then
integral = integral + j*(debug_StressLoopLiDistribution(j,1) + debug_StressLoopLiDistribution(j,2))
exceed = ' '
if (j > nStress) exceed = '+' ! last entry gets "+"
write(6,'(i25,a1,i10,1x,i10)') min(nStress,j),exceed,debug_StressLoopLiDistribution(j,1),&
debug_StressLoopLiDistribution(j,2)
endif
enddo
write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StressLoopLiDistribution(:,1)), &
sum(debug_StressLoopLiDistribution(:,2))
integral = 0_pInt
write(6,'(2/,a)') 'distribution_CrystalliteStateLoop :'
do j=1_pInt,nState+1_pInt
if (any(debug_StateLoopDistribution(j,:) /= 0)) then
integral = integral + j*(debug_StateLoopDistribution(j,1) + debug_StateLoopDistribution(j,2))
exceed = ' '
if (j > nState) exceed = '+' ! last entry gets "+"
write(6,'(i25,a1,i10,1x,i10)') min(nState,j),exceed,debug_StateLoopDistribution(j,1),&
debug_StateLoopDistribution(j,2)
endif
enddo
write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StateLoopDistribution(:,1)), &
sum(debug_StateLoopDistribution(:,2))
integral = 0_pInt
write(6,'(2/,a)') 'distribution_CrystalliteCutbackLoop :'
do j=1_pInt,nCryst+1_pInt
if (debug_CrystalliteLoopDistribution(j) /= 0) then
integral = integral + j*debug_CrystalliteLoopDistribution(j)
exceed = ' '
if (j > nCryst) exceed = '+'
write(6,'(i25,a1,i10)') min(nCryst,j),exceed,debug_CrystalliteLoopDistribution(j)
endif
enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution)
endif debugOutputCryst
debugOutputHomog: if (iand(debug_level(debug_HOMOGENIZATION),debug_LEVELBASIC) /= 0) then
integral = 0_pInt
write(6,'(2/,a)') 'distribution_MaterialpointStateLoop :'
do j=1_pInt,nMPstate
if (debug_MaterialpointStateLoopDistribution(j) /= 0) then
integral = integral + j*debug_MaterialpointStateLoopDistribution(j)
write(6,'(i25,1x,i10)') j,debug_MaterialpointStateLoopDistribution(j)
endif
enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution)
integral = 0_pInt
write(6,'(2/,a)') 'distribution_MaterialpointCutbackLoop :'
do j=1_pInt,nHomog+1_pInt
if (debug_MaterialpointLoopDistribution(j) /= 0) then
integral = integral + j*debug_MaterialpointLoopDistribution(j)
exceed = ' '
if (j > nHomog) exceed = '+'
write(6,'(i25,a1,i10)') min(nHomog,j),exceed,debug_MaterialpointLoopDistribution(j)
endif
enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution)
endif debugOutputHomog
debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0) then
write(6,'(2/,a,/)') ' Extreme values of returned stress and jacobian'
write(6,'(a39)') ' value el ip'
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' jacobian min :', debug_jacobianMin, debug_jacobianMinLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation
endif debugOutputCPFEM
!$OMP END CRITICAL (write2out)
end subroutine debug_info
end module debug

1396
src/homogenization.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

1558
src/homogenization_RGC.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

317
src/homogenization_isostrain.f90 Normal file
View File

@ -0,0 +1,317 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Isostrain (full constraint Taylor assuption) homogenization scheme
!--------------------------------------------------------------------------------------------------
module homogenization_isostrain
use prec, only: &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
homogenization_isostrain_sizePostResults
integer(pInt), dimension(:,:), allocatable, target, public :: &
homogenization_isostrain_sizePostResult
character(len=64), dimension(:,:), allocatable, target, public :: &
homogenization_isostrain_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
homogenization_isostrain_Noutput !< number of outputs per homog instance
integer(pInt), dimension(:), allocatable, private :: &
homogenization_isostrain_Ngrains
enum, bind(c)
enumerator :: undefined_ID, &
nconstituents_ID, &
ipcoords_ID, &
avgdefgrad_ID, &
avgfirstpiola_ID
end enum
enum, bind(c)
enumerator :: parallel_ID, &
average_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
homogenization_isostrain_outputID !< ID of each post result output
integer(kind(average_ID)), dimension(:), allocatable, private :: &
homogenization_isostrain_mapping !< mapping type
public :: &
homogenization_isostrain_init, &
homogenization_isostrain_partitionDeformation, &
homogenization_isostrain_averageStressAndItsTangent, &
homogenization_isostrain_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_isostrain_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: &
pReal
use debug, only: &
debug_HOMOGENIZATION, &
debug_level, &
debug_levelBasic
use IO
use material
use numerics, only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
section = 0_pInt, i, mySize, o
integer :: &
maxNinstance, &
homog, &
instance
integer :: &
NofMyHomog ! no pInt (stores a system dependen value from 'count'
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)
if (maxNinstance == 0) return
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(homogenization_isostrain_sizePostResults(maxNinstance), source=0_pInt)
allocate(homogenization_isostrain_sizePostResult(maxval(homogenization_Noutput),maxNinstance), &
source=0_pInt)
allocate(homogenization_isostrain_Noutput(maxNinstance), source=0_pInt)
allocate(homogenization_isostrain_Ngrains(maxNinstance), source=0_pInt)
allocate(homogenization_isostrain_mapping(maxNinstance), source=average_ID)
allocate(homogenization_isostrain_output(maxval(homogenization_Noutput),maxNinstance))
homogenization_isostrain_output = ''
allocate(homogenization_isostrain_outputID(maxval(homogenization_Noutput),maxNinstance), &
source=undefined_ID)
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
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

60
src/homogenization_none.f90 Normal file
View File

@ -0,0 +1,60 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief dummy homogenization homogenization scheme
!--------------------------------------------------------------------------------------------------
module homogenization_none
implicit none
private
public :: &
homogenization_none_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_none_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: &
pReal, &
pInt
use IO, only: &
IO_timeStamp
use material
use numerics, only: &
worldrank
implicit none
integer(pInt) :: &
homog, &
NofMyHomog
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then
NofMyHomog = count(material_homog == homog)
homogState(homog)%sizeState = 0_pInt
homogState(homog)%sizePostResults = 0_pInt
allocate(homogState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal)
allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
allocate(homogState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal)
endif myhomog
enddo initializeInstances
end subroutine homogenization_none_init
end module homogenization_none

513
src/hydrogenflux_cahnhilliard.f90 Normal file
View File

@ -0,0 +1,513 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for conservative transport of solute hydrogen
!> @details to be done
!--------------------------------------------------------------------------------------------------
module hydrogenflux_cahnhilliard
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
hydrogenflux_cahnhilliard_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
hydrogenflux_cahnhilliard_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
hydrogenflux_cahnhilliard_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
hydrogenflux_cahnhilliard_Noutput !< number of outputs per instance of this damage
real(pReal), parameter, private :: &
kB = 1.3806488e-23_pReal !< Boltzmann constant in J/Kelvin
enum, bind(c)
enumerator :: undefined_ID, &
hydrogenConc_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
hydrogenflux_cahnhilliard_outputID !< ID of each post result output
public :: &
hydrogenflux_cahnhilliard_init, &
hydrogenflux_cahnhilliard_getMobility33, &
hydrogenflux_cahnhilliard_getDiffusion33, &
hydrogenflux_cahnhilliard_getFormationEnergy, &
hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent, &
hydrogenflux_cahnhilliard_getChemPotAndItsTangent, &
hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate, &
hydrogenflux_cahnhilliard_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine hydrogenflux_cahnhilliard_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
hydrogenflux_type, &
hydrogenflux_typeInstance, &
homogenization_Noutput, &
HYDROGENFLUX_cahnhilliard_label, &
HYDROGENFLUX_cahnhilliard_ID, &
material_homog, &
mappingHomogenization, &
hydrogenfluxState, &
hydrogenfluxMapping, &
hydrogenConc, &
hydrogenConcRate, &
hydrogenflux_initialCh, &
material_partHomogenization, &
material_partPhase
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(hydrogenflux_cahnhilliard_sizePostResults(maxNinstance), source=0_pInt)
allocate(hydrogenflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(hydrogenflux_cahnhilliard_output (maxval(homogenization_Noutput),maxNinstance))
hydrogenflux_cahnhilliard_output = ''
allocate(hydrogenflux_cahnhilliard_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(hydrogenflux_cahnhilliard_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
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 <homogenization>
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

63
src/hydrogenflux_isoconc.f90 Normal file
View File

@ -0,0 +1,63 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for constant hydrogen concentration
!--------------------------------------------------------------------------------------------------
module hydrogenflux_isoconc
implicit none
private
public :: &
hydrogenflux_isoconc_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine hydrogenflux_isoconc_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: &
pReal, &
pInt
use IO, only: &
IO_timeStamp
use material
use numerics, only: &
worldrank
implicit none
integer(pInt) :: &
homog, &
NofMyHomog
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then
NofMyHomog = count(material_homog == homog)
hydrogenfluxState(homog)%sizeState = 0_pInt
hydrogenfluxState(homog)%sizePostResults = 0_pInt
allocate(hydrogenfluxState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal)
allocate(hydrogenfluxState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
allocate(hydrogenfluxState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal)
deallocate(hydrogenConc (homog)%p)
deallocate(hydrogenConcRate(homog)%p)
allocate (hydrogenConc (homog)%p(1), source=hydrogenflux_initialCh(homog))
allocate (hydrogenConcRate(homog)%p(1), source=0.0_pReal)
endif myhomog
enddo initializeInstances
end subroutine hydrogenflux_isoconc_init
end module hydrogenflux_isoconc

303
src/kinematics_cleavage_opening.f90 Normal file
View File

@ -0,0 +1,303 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Luv Sharma, Max-Planck-Institut fŸr Eisenforschung GmbH
!> @author Pratheek Shanthraj, Max-Planck-Institut fŸr Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from opening of cleavage planes
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_cleavage_opening
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_cleavage_opening_sizePostResults, & !< cumulative size of post results
kinematics_cleavage_opening_offset, & !< which kinematics is my current damage mechanism?
kinematics_cleavage_opening_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_cleavage_opening_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_cleavage_opening_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_cleavage_opening_Noutput !< number of outputs per instance of this damage
integer(pInt), dimension(:), allocatable, private :: &
kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems
integer(pInt), dimension(:,:), allocatable, private :: &
kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family
real(pReal), dimension(:), allocatable, private :: &
kinematics_cleavage_opening_sdot_0, &
kinematics_cleavage_opening_N
real(pReal), dimension(:,:), allocatable, private :: &
kinematics_cleavage_opening_critDisp, &
kinematics_cleavage_opening_critLoad
public :: &
kinematics_cleavage_opening_init, &
kinematics_cleavage_opening_LiAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_cleavage_opening_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_cleavage_opening_label, &
KINEMATICS_cleavage_opening_ID, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
worldrank
use lattice, only: &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_cleavage_opening_offset(material_Nphase), source=0_pInt)
allocate(kinematics_cleavage_opening_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_cleavage_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_cleavage_opening_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_cleavage_opening_ID) &
kinematics_cleavage_opening_offset(phase) = kinematics
enddo
enddo
allocate(kinematics_cleavage_opening_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_output(maxval(phase_Noutput),maxNinstance))
kinematics_cleavage_opening_output = ''
allocate(kinematics_cleavage_opening_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

264
src/kinematics_hydrogen_strain.f90 Normal file
View File

@ -0,0 +1,264 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from interstitial hydrogen
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_hydrogen_strain
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_hydrogen_strain_sizePostResults, & !< cumulative size of post results
kinematics_hydrogen_strain_offset, & !< which kinematics is my current damage mechanism?
kinematics_hydrogen_strain_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_hydrogen_strain_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_hydrogen_strain_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_hydrogen_strain_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
kinematics_hydrogen_strain_coeff
public :: &
kinematics_hydrogen_strain_init, &
kinematics_hydrogen_strain_initialStrain, &
kinematics_hydrogen_strain_LiAndItsTangent, &
kinematics_hydrogen_strain_ChemPotAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_hydrogen_strain_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_hydrogen_strain_label, &
KINEMATICS_hydrogen_strain_ID, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_hydrogen_strain_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_kinematics == KINEMATICS_hydrogen_strain_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_hydrogen_strain_offset(material_Nphase), source=0_pInt)
allocate(kinematics_hydrogen_strain_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_hydrogen_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_hydrogen_strain_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_hydrogen_strain_ID) &
kinematics_hydrogen_strain_offset(phase) = kinematics
enddo
enddo
allocate(kinematics_hydrogen_strain_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_hydrogen_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(kinematics_hydrogen_strain_output(maxval(phase_Noutput),maxNinstance))
kinematics_hydrogen_strain_output = ''
allocate(kinematics_hydrogen_strain_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_hydrogen_strain_coeff(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

323
src/kinematics_slipplane_opening.f90 Normal file
View File

@ -0,0 +1,323 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from opening of slip planes
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_slipplane_opening
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_slipplane_opening_sizePostResults, & !< cumulative size of post results
kinematics_slipplane_opening_offset, & !< which kinematics is my current damage mechanism?
kinematics_slipplane_opening_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_slipplane_opening_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_slipplane_opening_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_slipplane_opening_Noutput !< number of outputs per instance of this damage
integer(pInt), dimension(:), allocatable, private :: &
kinematics_slipplane_opening_totalNslip !< total number of slip systems
integer(pInt), dimension(:,:), allocatable, private :: &
kinematics_slipplane_opening_Nslip !< number of slip systems per family
real(pReal), dimension(:), allocatable, private :: &
kinematics_slipplane_opening_sdot_0, &
kinematics_slipplane_opening_N
real(pReal), dimension(:,:), allocatable, private :: &
kinematics_slipplane_opening_critPlasticStrain, &
kinematics_slipplane_opening_critLoad
public :: &
kinematics_slipplane_opening_init, &
kinematics_slipplane_opening_LiAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_slipplane_opening_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_slipplane_opening_label, &
KINEMATICS_slipplane_opening_ID, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
worldrank
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_slipplane_opening_offset(material_Nphase), source=0_pInt)
allocate(kinematics_slipplane_opening_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_slipplane_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_slipplane_opening_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_slipplane_opening_ID) &
kinematics_slipplane_opening_offset(phase) = kinematics
enddo
enddo
allocate(kinematics_slipplane_opening_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(kinematics_slipplane_opening_output(maxval(phase_Noutput),maxNinstance))
kinematics_slipplane_opening_output = ''
allocate(kinematics_slipplane_opening_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_slipplane_opening_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal)
allocate(kinematics_slipplane_opening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_totalNslip(maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_N(maxNinstance), source=0.0_pReal)
allocate(kinematics_slipplane_opening_sdot_0(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

228
src/kinematics_thermal_expansion.f90 Normal file
View File

@ -0,0 +1,228 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from thermal expansion
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_thermal_expansion
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_thermal_expansion_sizePostResults, & !< cumulative size of post results
kinematics_thermal_expansion_offset, & !< which kinematics is my current damage mechanism?
kinematics_thermal_expansion_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_thermal_expansion_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_thermal_expansion_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage
! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult
! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output
! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput...
! end enum
public :: &
kinematics_thermal_expansion_init, &
kinematics_thermal_expansion_initialStrain, &
kinematics_thermal_expansion_LiAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_thermal_expansion_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_thermal_expansion_label, &
KINEMATICS_thermal_expansion_ID, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
character(len=65536) :: &
tag = '', &
output = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_thermal_expansion_offset(material_Nphase), source=0_pInt)
allocate(kinematics_thermal_expansion_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_thermal_expansion_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_thermal_expansion_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_thermal_expansion_ID) &
kinematics_thermal_expansion_offset(phase) = kinematics
enddo
enddo
allocate(kinematics_thermal_expansion_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_thermal_expansion_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(kinematics_thermal_expansion_output(maxval(phase_Noutput),maxNinstance))
kinematics_thermal_expansion_output = ''
allocate(kinematics_thermal_expansion_Noutput(maxNinstance), source=0_pInt)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

265
src/kinematics_vacancy_strain.f90 Normal file
View File

@ -0,0 +1,265 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from vacancy point defects
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_vacancy_strain
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_vacancy_strain_sizePostResults, & !< cumulative size of post results
kinematics_vacancy_strain_offset, & !< which kinematics is my current damage mechanism?
kinematics_vacancy_strain_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_vacancy_strain_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_vacancy_strain_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_vacancy_strain_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
kinematics_vacancy_strain_coeff
public :: &
kinematics_vacancy_strain_init, &
kinematics_vacancy_strain_initialStrain, &
kinematics_vacancy_strain_LiAndItsTangent, &
kinematics_vacancy_strain_ChemPotAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_vacancy_strain_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_vacancy_strain_label, &
KINEMATICS_vacancy_strain_ID, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_vacancy_strain_offset(material_Nphase), source=0_pInt)
allocate(kinematics_vacancy_strain_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_vacancy_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_vacancy_strain_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_vacancy_strain_ID) &
kinematics_vacancy_strain_offset(phase) = kinematics
enddo
enddo
allocate(kinematics_vacancy_strain_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_vacancy_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(kinematics_vacancy_strain_output(maxval(phase_Noutput),maxNinstance))
kinematics_vacancy_strain_output = ''
allocate(kinematics_vacancy_strain_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_vacancy_strain_coeff(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

2239
src/lattice.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

14
src/libs.f90 Normal file
View File

@ -0,0 +1,14 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief dummy source for inclusion of Library files
!--------------------------------------------------------------------------------------------------
module libs
!nothing in here
end module libs
#include "../lib/IR_Precision.f90"
#include "../lib/Lib_Base64.f90"
#include "../lib/Lib_VTK_IO.f90"

1615
src/material.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

2678
src/math.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

4784
src/mesh.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

726
src/numerics.f90 Normal file
View File

@ -0,0 +1,726 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Managing of parameters related to numerics
!--------------------------------------------------------------------------------------------------
module numerics
use prec, only: &
pInt, &
pReal
implicit none
private
#ifdef PETSc
#include <petsc/finclude/petsc.h90>
#endif
character(len=64), parameter, private :: &
numerics_CONFIGFILE = 'numerics.config' !< name of configuration file
integer(pInt), protected, public :: &
iJacoStiffness = 1_pInt, & !< frequency of stiffness update
iJacoLpresiduum = 1_pInt, & !< frequency of Jacobian update of residuum in Lp
nHomog = 20_pInt, & !< homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog")
nMPstate = 10_pInt, & !< materialpoint state loop limit
nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst")
nState = 10_pInt, & !< state loop limit
nStress = 40_pInt, & !< stress loop limit
pert_method = 1_pInt, & !< method used in perturbation technique for tangent
fixedSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed
worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only)
worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only)
integer, protected, public :: &
DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
integer(pInt), public :: &
numerics_integrationMode = 0_pInt !< integrationMode 1 = central solution; integrationMode 2 = perturbation, Default 0: undefined, is not read from file
integer(pInt), dimension(2) , protected, public :: &
numerics_integrator = 1_pInt !< method used for state integration (central & perturbed state), Default 1: fix-point iteration for both states
real(pReal), protected, public :: &
relevantStrain = 1.0e-7_pReal, & !< strain increment considered significant (used by crystallite to determine whether strain inc is considered significant)
defgradTolerance = 1.0e-7_pReal, & !< deviation of deformation gradient that is still allowed (used by CPFEM to determine outdated ffn1)
pert_Fg = 1.0e-7_pReal, & !< strain perturbation for FEM Jacobi
subStepMinCryst = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in crystallite
subStepMinHomog = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in homogenization
subStepSizeCryst = 0.25_pReal, & !< size of first substep when cutback in crystallite
subStepSizeHomog = 0.25_pReal, & !< size of first substep when cutback in homogenization
stepIncreaseCryst = 1.5_pReal, & !< increase of next substep size when previous substep converged in crystallite
stepIncreaseHomog = 1.5_pReal, & !< increase of next substep size when previous substep converged in homogenization
rTol_crystalliteState = 1.0e-6_pReal, & !< relative tolerance in crystallite state loop
rTol_crystalliteStress = 1.0e-6_pReal, & !< relative tolerance in crystallite stress loop
aTol_crystalliteStress = 1.0e-8_pReal, & !< absolute tolerance in crystallite stress loop, Default 1.0e-8: residuum is in Lp and hence strain is on this order
numerics_unitlength = 1.0_pReal, & !< determines the physical length of one computational length unit
absTol_RGC = 1.0e+4_pReal, & !< absolute tolerance of RGC residuum
relTol_RGC = 1.0e-3_pReal, & !< relative tolerance of RGC residuum
absMax_RGC = 1.0e+10_pReal, & !< absolute maximum of RGC residuum
relMax_RGC = 1.0e+2_pReal, & !< relative maximum of RGC residuum
pPert_RGC = 1.0e-7_pReal, & !< perturbation for computing RGC penalty tangent
xSmoo_RGC = 1.0e-5_pReal, & !< RGC penalty smoothing parameter (hyperbolic tangent)
viscPower_RGC = 1.0e+0_pReal, & !< power (sensitivity rate) of numerical viscosity in RGC scheme, Default 1.0e0: Newton viscosity (linear model)
viscModus_RGC = 0.0e+0_pReal, & !< stress modulus of RGC numerical viscosity, Default 0.0e0: No viscosity is applied
refRelaxRate_RGC = 1.0e-3_pReal, & !< reference relaxation rate in RGC viscosity
maxdRelax_RGC = 1.0e+0_pReal, & !< threshold of maximum relaxation vector increment (if exceed this then cutback)
maxVolDiscr_RGC = 1.0e-5_pReal, & !< threshold of maximum volume discrepancy allowed
volDiscrMod_RGC = 1.0e+12_pReal, & !< stiffness of RGC volume discrepancy (zero = without volume discrepancy constraint)
volDiscrPow_RGC = 5.0_pReal, & !< powerlaw penalty for volume discrepancy
charLength = 1.0_pReal, & !< characteristic length scale for gradient problems
residualStiffness = 1.0e-6_pReal !< non-zero residual damage
logical, protected, public :: &
analyticJaco = .true., & !< use analytic Jacobian or perturbation, Default for Spectral solver .true.:
usePingPong = .true., &
numerics_timeSyncing = .false. !< flag indicating if time synchronization in crystallite is used for nonlocal plasticity
!--------------------------------------------------------------------------------------------------
! field parameters:
real(pReal), protected, public :: &
err_struct_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for mechanical equilibrium
err_struct_tolRel = 1.0e-4_pReal, & !< relative tolerance for mechanical equilibrium
err_thermal_tolAbs = 1.0e-2_pReal, & !< absolute tolerance for thermal equilibrium
err_thermal_tolRel = 1.0e-6_pReal, & !< relative tolerance for thermal equilibrium
err_damage_tolAbs = 1.0e-2_pReal, & !< absolute tolerance for damage evolution
err_damage_tolRel = 1.0e-6_pReal, & !< relative tolerance for damage evolution
err_vacancyflux_tolAbs = 1.0e-8_pReal, & !< absolute tolerance for vacancy transport
err_vacancyflux_tolRel = 1.0e-6_pReal, & !< relative tolerance for vacancy transport
err_porosity_tolAbs = 1.0e-2_pReal, & !< absolute tolerance for porosity evolution
err_porosity_tolRel = 1.0e-6_pReal, & !< relative tolerance for porosity evolution
err_hydrogenflux_tolAbs = 1.0e-8_pReal, & !< absolute tolerance for hydrogen transport
err_hydrogenflux_tolRel = 1.0e-6_pReal, & !< relative tolerance for hydrogen transport
vacancyBoundPenalty = 1.0e+4_pReal, & !< penalty to enforce 0 < Cv < 1
hydrogenBoundPenalty = 1.0e+4_pReal !< penalty to enforce 0 < Ch < 1
integer(pInt), protected, public :: &
itmax = 250_pInt, & !< maximum number of iterations
itmin = 1_pInt, & !< minimum number of iterations
stagItMax = 10_pInt, & !< max number of field level staggered iterations
maxCutBack = 3_pInt, & !< max number of cut backs
vacancyPolyOrder = 10_pInt, & !< order of polynomial approximation of entropic contribution to vacancy chemical potential
hydrogenPolyOrder = 10_pInt !< order of polynomial approximation of entropic contribution to hydrogen chemical potential
!--------------------------------------------------------------------------------------------------
! spectral parameters:
#ifdef Spectral
real(pReal), protected, public :: &
err_div_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for equilibrium
err_div_tolRel = 5.0e-4_pReal, & !< relative tolerance for equilibrium
err_curl_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for compatibility
err_curl_tolRel = 5.0e-4_pReal, & !< relative tolerance for compatibility
err_stress_tolAbs = 1.0e3_pReal, & !< absolute tolerance for fullfillment of stress BC
err_stress_tolRel = 0.01_pReal, & !< relative tolerance for fullfillment of stress BC
fftw_timelimit = -1.0_pReal, & !< sets the timelimit of plan creation for FFTW, see manual on www.fftw.org, Default -1.0: disable timelimit
rotation_tol = 1.0e-12_pReal, & !< tolerance of rotation specified in loadcase, Default 1.0e-12: first guess
polarAlpha = 1.0_pReal, & !< polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
polarBeta = 1.0_pReal !< polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
character(len=64), private :: &
fftw_plan_mode = 'FFTW_PATIENT' !< reads the planing-rigor flag, see manual on www.fftw.org, Default FFTW_PATIENT: use patient planner flag
character(len=64), protected, public :: &
spectral_solver = 'basicpetsc' , & !< spectral solution method
spectral_derivative = 'continuous' !< spectral filtering method
character(len=1024), protected, public :: &
petsc_defaultOptions = '-mech_snes_type ngmres &
&-damage_snes_type ngmres &
&-thermal_snes_type ngmres ', &
petsc_options = ''
integer(pInt), protected, public :: &
fftw_planner_flag = 32_pInt, & !< conversion of fftw_plan_mode to integer, basically what is usually done in the include file of fftw
continueCalculation = 0_pInt, & !< 0: exit if BVP solver does not converge, 1: continue calculation if BVP solver does not converge
divergence_correction = 2_pInt !< correct divergence calculation in fourier space 0: no correction, 1: size scaled to 1, 2: size scaled to Npoints
logical, protected, public :: &
memory_efficient = .true., & !< for fast execution (pre calculation of gamma_hat), Default .true.: do not precalculate
update_gamma = .false. !< update gamma operator with current stiffness, Default .false.: use initial stiffness
#endif
!--------------------------------------------------------------------------------------------------
! FEM parameters:
#ifdef FEM
integer(pInt), protected, public :: &
integrationOrder = 2_pInt, & !< order of quadrature rule required
structOrder = 2_pInt, & !< order of displacement shape functions
thermalOrder = 2_pInt, & !< order of temperature field shape functions
damageOrder = 2_pInt, & !< order of damage field shape functions
vacancyfluxOrder = 2_pInt, & !< order of vacancy concentration and chemical potential field shape functions
porosityOrder = 2_pInt, & !< order of porosity field shape functions
hydrogenfluxOrder = 2_pInt !< order of hydrogen concentration and chemical potential field shape functions
logical, protected, public :: &
BBarStabilisation = .false.
character(len=4096), protected, public :: &
petsc_defaultOptions = '-mech_snes_type newtonls &
&-mech_snes_linesearch_type cp &
&-mech_snes_ksp_ew &
&-mech_snes_ksp_ew_rtol0 0.01 &
&-mech_snes_ksp_ew_rtolmax 0.01 &
&-mech_ksp_type fgmres &
&-mech_ksp_max_it 25 &
&-mech_pc_type ml &
&-mech_mg_levels_ksp_type chebyshev &
&-mech_mg_levels_pc_type sor &
&-mech_pc_ml_nullspace user &
&-damage_snes_type vinewtonrsls &
&-damage_snes_atol 1e-8 &
&-damage_ksp_type preonly &
&-damage_ksp_max_it 25 &
&-damage_pc_type cholesky &
&-damage_pc_factor_mat_solver_package mumps &
&-thermal_snes_type newtonls &
&-thermal_snes_linesearch_type cp &
&-thermal_ksp_type fgmres &
&-thermal_ksp_max_it 25 &
&-thermal_snes_atol 1e-3 &
&-thermal_pc_type hypre &
&-vacancy_snes_type newtonls &
&-vacancy_snes_linesearch_type cp &
&-vacancy_snes_atol 1e-9 &
&-vacancy_ksp_type fgmres &
&-vacancy_ksp_max_it 25 &
&-vacancy_pc_type ml &
&-vacancy_mg_levels_ksp_type chebyshev &
&-vacancy_mg_levels_pc_type sor &
&-porosity_snes_type newtonls &
&-porosity_snes_atol 1e-8 &
&-porosity_ksp_type fgmres &
&-porosity_ksp_max_it 25 &
&-porosity_pc_type hypre &
&-hydrogen_snes_type newtonls &
&-hydrogen_snes_linesearch_type cp &
&-hydrogen_snes_atol 1e-9 &
&-hydrogen_ksp_type fgmres &
&-hydrogen_ksp_max_it 25 &
&-hydrogen_pc_type ml &
&-hydrogen_mg_levels_ksp_type chebyshev &
&-hydrogen_mg_levels_pc_type sor ', &
petsc_options = ''
#endif
public :: numerics_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief reads in parameters from numerics.config and sets openMP related parameters. Also does
! a sanity check
!--------------------------------------------------------------------------------------------------
subroutine numerics_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_read, &
IO_error, &
IO_open_file_stat, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_lc, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_timeStamp, &
IO_EOF
#if defined(Spectral) || defined(FEM)
!$ use OMP_LIB, only: omp_set_num_threads ! Use the standard conforming module file for omp if using the spectral solver
implicit none
#else
implicit none
!$ include "omp_lib.h" ! use the not F90 standard conforming include file to prevent crashes with some versions of MSC.Marc
#endif
integer(pInt), parameter :: FILEUNIT = 300_pInt
!$ integer :: gotDAMASK_NUM_THREADS = 1
integer :: i, ierr ! no pInt
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: &
tag ,&
line
!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS
external :: &
MPI_Comm_rank, &
MPI_Comm_size, &
MPI_Abort
#ifdef PETSc
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)
call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr)
#endif
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- numerics init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
!$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS...
!$ if(gotDAMASK_NUM_THREADS /= 0) then ! could not get number of threads, set it to 1
!$ call IO_warning(35_pInt,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END')
!$ DAMASK_NumThreadsInt = 1
!$ else
!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer
!$ if (DAMASK_NumThreadsInt < 1) DAMASK_NumThreadsInt = 1 ! in case of string conversion fails, set it to one
!$ endif
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution
!--------------------------------------------------------------------------------------------------
! try to open the config file
fileExists: if(IO_open_file_stat(FILEUNIT,numerics_configFile)) then
mainProcess2: if (worldrank == 0) then
write(6,'(a,/)') ' using values from config file'
flush(6)
endif mainProcess2
!--------------------------------------------------------------------------------------------------
! read variables from config file and overwrite default parameters if keyword is present
line = ''
do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(FILEUNIT)
do i=1,len(line)
if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version
enddo
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('relevantstrain')
relevantStrain = IO_floatValue(line,chunkPos,2_pInt)
case ('defgradtolerance')
defgradTolerance = IO_floatValue(line,chunkPos,2_pInt)
case ('ijacostiffness')
iJacoStiffness = IO_intValue(line,chunkPos,2_pInt)
case ('ijacolpresiduum')
iJacoLpresiduum = IO_intValue(line,chunkPos,2_pInt)
case ('pert_fg')
pert_Fg = IO_floatValue(line,chunkPos,2_pInt)
case ('pert_method')
pert_method = IO_intValue(line,chunkPos,2_pInt)
case ('nhomog')
nHomog = IO_intValue(line,chunkPos,2_pInt)
case ('nmpstate')
nMPstate = IO_intValue(line,chunkPos,2_pInt)
case ('ncryst')
nCryst = IO_intValue(line,chunkPos,2_pInt)
case ('nstate')
nState = IO_intValue(line,chunkPos,2_pInt)
case ('nstress')
nStress = IO_intValue(line,chunkPos,2_pInt)
case ('substepmincryst')
subStepMinCryst = IO_floatValue(line,chunkPos,2_pInt)
case ('substepsizecryst')
subStepSizeCryst = IO_floatValue(line,chunkPos,2_pInt)
case ('stepincreasecryst')
stepIncreaseCryst = IO_floatValue(line,chunkPos,2_pInt)
case ('substepminhomog')
subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt)
case ('substepsizehomog')
subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt)
case ('stepincreasehomog')
stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt)
case ('rtol_crystallitestate')
rTol_crystalliteState = IO_floatValue(line,chunkPos,2_pInt)
case ('rtol_crystallitestress')
rTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt)
case ('atol_crystallitestress')
aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt)
case ('integrator')
numerics_integrator(1) = IO_intValue(line,chunkPos,2_pInt)
case ('integratorstiffness')
numerics_integrator(2) = IO_intValue(line,chunkPos,2_pInt)
case ('analyticjaco')
analyticJaco = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('usepingpong')
usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('timesyncing')
numerics_timeSyncing = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('unitlength')
numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt)
!--------------------------------------------------------------------------------------------------
! RGC parameters
case ('atol_rgc')
absTol_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('rtol_rgc')
relTol_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('amax_rgc')
absMax_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('rmax_rgc')
relMax_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('perturbpenalty_rgc')
pPert_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('relevantmismatch_rgc')
xSmoo_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('viscositypower_rgc')
viscPower_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('viscositymodulus_rgc')
viscModus_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('refrelaxationrate_rgc')
refRelaxRate_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('maxrelaxation_rgc')
maxdRelax_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('maxvoldiscrepancy_rgc')
maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('voldiscrepancymod_rgc')
volDiscrMod_RGC = IO_floatValue(line,chunkPos,2_pInt)
case ('discrepancypower_rgc')
volDiscrPow_RGC = IO_floatValue(line,chunkPos,2_pInt)
!--------------------------------------------------------------------------------------------------
! random seeding parameter
case ('fixed_seed')
fixedSeed = IO_intValue(line,chunkPos,2_pInt)
!--------------------------------------------------------------------------------------------------
! gradient parameter
case ('charlength')
charLength = IO_floatValue(line,chunkPos,2_pInt)
case ('residualstiffness')
residualStiffness = IO_floatValue(line,chunkPos,2_pInt)
!--------------------------------------------------------------------------------------------------
! field parameters
case ('err_struct_tolabs')
err_struct_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_struct_tolrel')
err_struct_tolRel = IO_floatValue(line,chunkPos,2_pInt)
case ('err_thermal_tolabs')
err_thermal_tolabs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_thermal_tolrel')
err_thermal_tolrel = IO_floatValue(line,chunkPos,2_pInt)
case ('err_damage_tolabs')
err_damage_tolabs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_damage_tolrel')
err_damage_tolrel = IO_floatValue(line,chunkPos,2_pInt)
case ('err_vacancyflux_tolabs')
err_vacancyflux_tolabs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_vacancyflux_tolrel')
err_vacancyflux_tolrel = IO_floatValue(line,chunkPos,2_pInt)
case ('err_porosity_tolabs')
err_porosity_tolabs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_porosity_tolrel')
err_porosity_tolrel = IO_floatValue(line,chunkPos,2_pInt)
case ('err_hydrogenflux_tolabs')
err_hydrogenflux_tolabs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_hydrogenflux_tolrel')
err_hydrogenflux_tolrel = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyboundpenalty')
vacancyBoundPenalty = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenboundpenalty')
hydrogenBoundPenalty = IO_floatValue(line,chunkPos,2_pInt)
case ('itmax')
itmax = IO_intValue(line,chunkPos,2_pInt)
case ('itmin')
itmin = IO_intValue(line,chunkPos,2_pInt)
case ('maxcutback')
maxCutBack = IO_intValue(line,chunkPos,2_pInt)
case ('maxstaggerediter')
stagItMax = IO_intValue(line,chunkPos,2_pInt)
case ('vacancypolyorder')
vacancyPolyOrder = IO_intValue(line,chunkPos,2_pInt)
case ('hydrogenpolyorder')
hydrogenPolyOrder = IO_intValue(line,chunkPos,2_pInt)
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral
case ('err_div_tolabs')
err_div_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_div_tolrel')
err_div_tolRel = IO_floatValue(line,chunkPos,2_pInt)
case ('err_stress_tolrel')
err_stress_tolrel = IO_floatValue(line,chunkPos,2_pInt)
case ('err_stress_tolabs')
err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt)
case ('continuecalculation')
continueCalculation = IO_intValue(line,chunkPos,2_pInt)
case ('memory_efficient')
memory_efficient = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('fftw_timelimit')
fftw_timelimit = IO_floatValue(line,chunkPos,2_pInt)
case ('fftw_plan_mode')
fftw_plan_mode = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('spectralderivative')
spectral_derivative = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('divergence_correction')
divergence_correction = IO_intValue(line,chunkPos,2_pInt)
case ('update_gamma')
update_gamma = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('petsc_options')
petsc_options = trim(line(chunkPos(4):))
case ('spectralsolver','myspectralsolver')
spectral_solver = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('err_curl_tolabs')
err_curl_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
case ('err_curl_tolrel')
err_curl_tolRel = IO_floatValue(line,chunkPos,2_pInt)
case ('polaralpha')
polarAlpha = IO_floatValue(line,chunkPos,2_pInt)
case ('polarbeta')
polarBeta = IO_floatValue(line,chunkPos,2_pInt)
#else
case ('err_div_tolabs','err_div_tolrel','err_stress_tolrel','err_stress_tolabs',& ! found spectral parameter for FEM build
'memory_efficient','fftw_timelimit','fftw_plan_mode', &
'divergence_correction','update_gamma','spectralfilter','myfilter', &
'err_curl_tolabs','err_curl_tolrel', &
'polaralpha','polarbeta')
call IO_warning(40_pInt,ext_msg=tag)
#endif
!--------------------------------------------------------------------------------------------------
! FEM parameters
#ifdef FEM
case ('integrationorder')
integrationorder = IO_intValue(line,chunkPos,2_pInt)
case ('structorder')
structorder = IO_intValue(line,chunkPos,2_pInt)
case ('thermalorder')
thermalorder = IO_intValue(line,chunkPos,2_pInt)
case ('damageorder')
damageorder = IO_intValue(line,chunkPos,2_pInt)
case ('vacancyfluxorder')
vacancyfluxOrder = IO_intValue(line,chunkPos,2_pInt)
case ('porosityorder')
porosityOrder = IO_intValue(line,chunkPos,2_pInt)
case ('hydrogenfluxorder')
hydrogenfluxOrder = IO_intValue(line,chunkPos,2_pInt)
case ('petsc_options')
petsc_options = trim(line(chunkPos(4):))
case ('bbarstabilisation')
BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
#else
case ('integrationorder','structorder','thermalorder', 'damageorder','vacancyfluxorder', &
'porosityorder','hydrogenfluxorder','bbarstabilisation')
call IO_warning(40_pInt,ext_msg=tag)
#endif
case default ! found unknown keyword
call IO_error(300_pInt,ext_msg=tag)
endselect
enddo
close(FILEUNIT)
else fileExists
#ifdef FEM
if (worldrank == 0) then
#endif
write(6,'(a,/)') ' using standard values'
flush(6)
#ifdef FEM
endif
#endif
endif fileExists
#ifdef Spectral
select case(IO_lc(fftw_plan_mode)) ! setting parameters for the plan creation of FFTW. Basically a translation from fftw3.f
case('estimate','fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution
fftw_planner_flag = 64_pInt
case('measure','fftw_measure')
fftw_planner_flag = 0_pInt
case('patient','fftw_patient')
fftw_planner_flag= 32_pInt
case('exhaustive','fftw_exhaustive')
fftw_planner_flag = 8_pInt
case default
call IO_warning(warning_ID=47_pInt,ext_msg=trim(IO_lc(fftw_plan_mode)))
fftw_planner_flag = 32_pInt
end select
#endif
numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator
!--------------------------------------------------------------------------------------------------
! writing parameters to output
mainProcess3: if (worldrank == 0) then
write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain
write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance
write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness
write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum
write(6,'(a24,1x,es8.1)') ' pert_Fg: ',pert_Fg
write(6,'(a24,1x,i8)') ' pert_method: ',pert_method
write(6,'(a24,1x,i8)') ' nCryst: ',nCryst
write(6,'(a24,1x,es8.1)') ' subStepMinCryst: ',subStepMinCryst
write(6,'(a24,1x,es8.1)') ' subStepSizeCryst: ',subStepSizeCryst
write(6,'(a24,1x,es8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst
write(6,'(a24,1x,i8)') ' nState: ',nState
write(6,'(a24,1x,i8)') ' nStress: ',nStress
write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState
write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress
write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress
write(6,'(a24,2(1x,i8))') ' integrator: ',numerics_integrator
write(6,'(a24,1x,L8)') ' timeSyncing: ',numerics_timeSyncing
write(6,'(a24,1x,L8)') ' analytic Jacobian: ',analyticJaco
write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong
write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength
write(6,'(a24,1x,i8)') ' nHomog: ',nHomog
write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog
write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog
write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog
write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate
!--------------------------------------------------------------------------------------------------
! RGC parameters
write(6,'(a24,1x,es8.1)') ' aTol_RGC: ',absTol_RGC
write(6,'(a24,1x,es8.1)') ' rTol_RGC: ',relTol_RGC
write(6,'(a24,1x,es8.1)') ' aMax_RGC: ',absMax_RGC
write(6,'(a24,1x,es8.1)') ' rMax_RGC: ',relMax_RGC
write(6,'(a24,1x,es8.1)') ' perturbPenalty_RGC: ',pPert_RGC
write(6,'(a24,1x,es8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC
write(6,'(a24,1x,es8.1)') ' viscosityrate_RGC: ',viscPower_RGC
write(6,'(a24,1x,es8.1)') ' viscositymodulus_RGC: ',viscModus_RGC
write(6,'(a24,1x,es8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC
write(6,'(a24,1x,es8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC
write(6,'(a24,1x,es8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC
write(6,'(a24,1x,es8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC
!--------------------------------------------------------------------------------------------------
! Random seeding parameter
write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed
if (fixedSeed <= 0_pInt) &
write(6,'(a,/)') ' No fixed Seed: Random is random!'
!--------------------------------------------------------------------------------------------------
! gradient parameter
write(6,'(a24,1x,es8.1)') ' charLength: ',charLength
write(6,'(a24,1x,es8.1)') ' residualStiffness: ',residualStiffness
!--------------------------------------------------------------------------------------------------
! openMP parameter
!$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt
!--------------------------------------------------------------------------------------------------
! field parameters
write(6,'(a24,1x,i8)') ' itmax: ',itmax
write(6,'(a24,1x,i8)') ' itmin: ',itmin
write(6,'(a24,1x,i8)') ' maxCutBack: ',maxCutBack
write(6,'(a24,1x,i8)') ' maxStaggeredIter: ',stagItMax
write(6,'(a24,1x,i8)') ' vacancyPolyOrder: ',vacancyPolyOrder
write(6,'(a24,1x,i8)') ' hydrogenPolyOrder: ',hydrogenPolyOrder
write(6,'(a24,1x,es8.1)') ' err_struct_tolAbs: ',err_struct_tolAbs
write(6,'(a24,1x,es8.1)') ' err_struct_tolRel: ',err_struct_tolRel
write(6,'(a24,1x,es8.1)') ' err_thermal_tolabs: ',err_thermal_tolabs
write(6,'(a24,1x,es8.1)') ' err_thermal_tolrel: ',err_thermal_tolrel
write(6,'(a24,1x,es8.1)') ' err_damage_tolabs: ',err_damage_tolabs
write(6,'(a24,1x,es8.1)') ' err_damage_tolrel: ',err_damage_tolrel
write(6,'(a24,1x,es8.1)') ' err_vacancyflux_tolabs: ',err_vacancyflux_tolabs
write(6,'(a24,1x,es8.1)') ' err_vacancyflux_tolrel: ',err_vacancyflux_tolrel
write(6,'(a24,1x,es8.1)') ' err_porosity_tolabs: ',err_porosity_tolabs
write(6,'(a24,1x,es8.1)') ' err_porosity_tolrel: ',err_porosity_tolrel
write(6,'(a24,1x,es8.1)') ' err_hydrogenflux_tolabs:',err_hydrogenflux_tolabs
write(6,'(a24,1x,es8.1)') ' err_hydrogenflux_tolrel:',err_hydrogenflux_tolrel
write(6,'(a24,1x,es8.1)') ' vacancyBoundPenalty: ',vacancyBoundPenalty
write(6,'(a24,1x,es8.1)') ' hydrogenBoundPenalty: ',hydrogenBoundPenalty
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral
write(6,'(a24,1x,i8)') ' continueCalculation: ',continueCalculation
write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient
write(6,'(a24,1x,i8)') ' divergence_correction: ',divergence_correction
write(6,'(a24,1x,a)') ' spectral_derivative: ',trim(spectral_derivative)
if(fftw_timelimit<0.0_pReal) then
write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false.
else
write(6,'(a24,1x,es8.1)') ' fftw_timelimit: ',fftw_timelimit
endif
write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode)
write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag
write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma
write(6,'(a24,1x,es8.1)') ' err_stress_tolAbs: ',err_stress_tolAbs
write(6,'(a24,1x,es8.1)') ' err_stress_tolRel: ',err_stress_tolRel
write(6,'(a24,1x,es8.1)') ' err_div_tolAbs: ',err_div_tolAbs
write(6,'(a24,1x,es8.1)') ' err_div_tolRel: ',err_div_tolRel
write(6,'(a24,1x,es8.1)') ' err_curl_tolAbs: ',err_curl_tolAbs
write(6,'(a24,1x,es8.1)') ' err_curl_tolRel: ',err_curl_tolRel
write(6,'(a24,1x,es8.1)') ' polarAlpha: ',polarAlpha
write(6,'(a24,1x,es8.1)') ' polarBeta: ',polarBeta
write(6,'(a24,1x,a)') ' spectral solver: ',trim(spectral_solver)
write(6,'(a24,1x,a)') ' PETSc_options: ',trim(petsc_defaultOptions)//' '//trim(petsc_options)
#endif
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef FEM
write(6,'(a24,1x,i8)') ' integrationOrder: ',integrationOrder
write(6,'(a24,1x,i8)') ' structOrder: ',structOrder
write(6,'(a24,1x,i8)') ' thermalOrder: ',thermalOrder
write(6,'(a24,1x,i8)') ' damageOrder: ',damageOrder
write(6,'(a24,1x,i8)') ' vacancyfluxOrder: ',vacancyfluxOrder
write(6,'(a24,1x,i8)') ' porosityOrder: ',porosityOrder
write(6,'(a24,1x,i8)') ' hydrogenfluxOrder: ',hydrogenfluxOrder
write(6,'(a24,1x,a)') ' PETSc_options: ',trim(petsc_defaultOptions)//' '//trim(petsc_options)
write(6,'(a24,1x,L8)') ' B-Bar stabilisation: ',BBarStabilisation
#endif
endif mainProcess3
!--------------------------------------------------------------------------------------------------
! sanity checks
if (relevantStrain <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relevantStrain')
if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance')
if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness')
if (iJacoLpresiduum < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoLpresiduum')
if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg')
if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) &
call IO_error(301_pInt,ext_msg='pert_method')
if (nHomog < 1_pInt) call IO_error(301_pInt,ext_msg='nHomog')
if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate')
if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst')
if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState')
if (nStress < 1_pInt) call IO_error(301_pInt,ext_msg='nStress')
if (subStepMinCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinCryst')
if (subStepSizeCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeCryst')
if (stepIncreaseCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseCryst')
if (subStepMinHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinHomog')
if (subStepSizeHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeHomog')
if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseHomog')
if (rTol_crystalliteState <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteState')
if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteStress')
if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='aTol_crystalliteStress')
if (any(numerics_integrator <= 0_pInt) .or. any(numerics_integrator >= 6_pInt)) &
call IO_error(301_pInt,ext_msg='integrator')
if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength')
if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC')
if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_RGC')
if (absMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absMax_RGC')
if (relMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relMax_RGC')
if (pPert_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pPert_RGC')
if (xSmoo_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='xSmoo_RGC')
if (viscPower_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscPower_RGC')
if (viscModus_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscModus_RGC')
if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='refRelaxRate_RGC')
if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxdRelax_RGC')
if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxVolDiscr_RGC')
if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrMod_RGC')
if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC')
if (residualStiffness < 0.0_pReal) call IO_error(301_pInt,ext_msg='residualStiffness')
if (itmax <= 1_pInt) call IO_error(301_pInt,ext_msg='itmax')
if (itmin > itmax .or. itmin < 1_pInt) call IO_error(301_pInt,ext_msg='itmin')
if (maxCutBack < 0_pInt) call IO_error(301_pInt,ext_msg='maxCutBack')
if (stagItMax < 0_pInt) call IO_error(301_pInt,ext_msg='maxStaggeredIter')
if (vacancyPolyOrder < 0_pInt) call IO_error(301_pInt,ext_msg='vacancyPolyOrder')
if (err_struct_tolRel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_struct_tolRel')
if (err_struct_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_struct_tolAbs')
if (err_thermal_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_thermal_tolabs')
if (err_thermal_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_thermal_tolrel')
if (err_damage_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_damage_tolabs')
if (err_damage_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_damage_tolrel')
if (err_vacancyflux_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_vacancyflux_tolabs')
if (err_vacancyflux_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_vacancyflux_tolrel')
if (err_porosity_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_porosity_tolabs')
if (err_porosity_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_porosity_tolrel')
if (err_hydrogenflux_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_hydrogenflux_tolabs')
if (err_hydrogenflux_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_hydrogenflux_tolrel')
#ifdef Spectral
if (continueCalculation /= 0_pInt .and. &
continueCalculation /= 1_pInt) call IO_error(301_pInt,ext_msg='continueCalculation')
if (divergence_correction < 0_pInt .or. &
divergence_correction > 2_pInt) call IO_error(301_pInt,ext_msg='divergence_correction')
if (update_gamma .and. &
.not. memory_efficient) call IO_error(error_ID = 847_pInt)
if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolRel')
if (err_stress_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolAbs')
if (err_div_tolRel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tolRel')
if (err_div_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tolAbs')
if (err_curl_tolRel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_curl_tolRel')
if (err_curl_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_curl_tolAbs')
if (polarAlpha <= 0.0_pReal .or. &
polarAlpha > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarAlpha')
if (polarBeta < 0.0_pReal .or. &
polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta')
#endif
end subroutine numerics_init
end module numerics

2116
src/plastic_disloUCLA.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

2542
src/plastic_dislotwin.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

678
src/plastic_isotropic.f90 Normal file
View File

@ -0,0 +1,678 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for isotropic (ISOTROPIC) plasticity
!> @details Isotropic (ISOTROPIC) Plasticity which resembles the phenopowerlaw plasticity without
!! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an
!! untextured polycrystal
!--------------------------------------------------------------------------------------------------
module plastic_isotropic
#ifdef HDF
use hdf5, only: &
HID_T
#endif
use prec, only: &
pReal,&
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_isotropic_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_isotropic_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
plastic_isotropic_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
plastic_isotropic_Noutput !< number of outputs per instance
enum, bind(c)
enumerator :: undefined_ID, &
flowstress_ID, &
strainrate_ID
end enum
type, private :: tParameters !< container type for internal constitutive parameters
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
real(pReal) :: &
fTaylor, &
tau0, &
gdot0, &
n, &
h0, &
h0_slopeLnRate, &
tausat, &
a, &
aTolFlowstress, &
aTolShear , &
tausat_SinhFitA, &
tausat_SinhFitB, &
tausat_SinhFitC, &
tausat_SinhFitD
logical :: &
dilatation
end type
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type, private :: tIsotropicState !< internal state aliases
real(pReal), pointer, dimension(:) :: & ! scalars along NipcMyInstance
flowstress, &
accumulatedShear
end type
type, private :: tIsotropicAbsTol !< internal alias for abs tolerance in state
real(pReal), pointer :: & ! scalars along NipcMyInstance
flowstress, &
accumulatedShear
end type
type(tIsotropicState), allocatable, dimension(:), private :: & !< state aliases per instance
state, &
state0, &
dotState
type(tIsotropicAbsTol), allocatable, dimension(:), private :: & !< state aliases per instance
stateAbsTol
public :: &
plastic_isotropic_init, &
plastic_isotropic_LpAndItsTangent, &
plastic_isotropic_LiAndItsTangent, &
plastic_isotropic_dotState, &
plastic_isotropic_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic
use numerics, only: &
analyticJaco, &
worldrank, &
numerics_integrator
use math, only: &
math_Mandel3333to66, &
math_Voigt66to3333
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_plasticity, &
phase_plasticityInstance, &
phase_Noutput, &
PLASTICITY_ISOTROPIC_label, &
PLASTICITY_ISOTROPIC_ID, &
material_phase, &
plasticState, &
MATERIAL_partPhase
use lattice
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
o, &
phase, &
instance, &
maxNinstance, &
mySize, &
sizeDotState, &
sizeState, &
sizeDeltaState
character(len=65536) :: &
tag = '', &
outputtag = '', &
line = '', &
extmsg = ''
integer(pInt) :: NipcMyPhase
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(plastic_isotropic_sizePostResults(maxNinstance), source=0_pInt)
allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt)
allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance))
plastic_isotropic_output = ''
allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt)
allocate(param(maxNinstance)) ! one container of parameters per instance
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to <phase>
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

579
src/plastic_j2.f90 Normal file
View File

@ -0,0 +1,579 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for isotropic (J2) plasticity
!> @details Isotropic (J2) Plasticity which resembles the phenopowerlaw plasticity without
!! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an
!! untextured polycrystal
!--------------------------------------------------------------------------------------------------
module plastic_j2
#ifdef HDF
use hdf5, only: &
HID_T
#endif
use prec, only: &
pReal,&
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_j2_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_j2_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
plastic_j2_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
plastic_j2_Noutput !< number of outputs per instance
real(pReal), dimension(:), allocatable, private :: &
plastic_j2_fTaylor, & !< Taylor factor
plastic_j2_tau0, & !< initial plastic stress
plastic_j2_gdot0, & !< reference velocity
plastic_j2_n, & !< Visco-plastic parameter
!--------------------------------------------------------------------------------------------------
! h0 as function of h0 = A + B log (gammadot)
plastic_j2_h0, &
plastic_j2_h0_slopeLnRate, &
plastic_j2_tausat, & !< final plastic stress
plastic_j2_a, &
plastic_j2_aTolResistance, &
plastic_j2_aTolShear, &
!--------------------------------------------------------------------------------------------------
! tausat += (asinh((gammadot / SinhFitA)**(1 / SinhFitD)))**(1 / SinhFitC) / (SinhFitB * (gammadot / gammadot0)**(1/n))
plastic_j2_tausat_SinhFitA, & !< fitting parameter for normalized strain rate vs. stress function
plastic_j2_tausat_SinhFitB, & !< fitting parameter for normalized strain rate vs. stress function
plastic_j2_tausat_SinhFitC, & !< fitting parameter for normalized strain rate vs. stress function
plastic_j2_tausat_SinhFitD !< fitting parameter for normalized strain rate vs. stress function
enum, bind(c)
enumerator :: undefined_ID, &
flowstress_ID, &
strainrate_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
plastic_j2_outputID !< ID of each post result output
#ifdef HDF
type plastic_j2_tOutput
real(pReal), dimension(:), allocatable, private :: &
flowstress, &
strainrate
logical :: flowstressActive = .false., strainrateActive = .false. ! if we can write the output block wise, this is not needed anymore because we can do an if(allocated(xxx))
end type plastic_j2_tOutput
type(plastic_j2_tOutput), allocatable, dimension(:) :: plastic_j2_Output2
integer(HID_T), allocatable, dimension(:) :: outID
#endif
public :: &
plastic_j2_init, &
plastic_j2_LpAndItsTangent, &
plastic_j2_dotState, &
plastic_j2_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_j2_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
#ifdef HDF
use hdf5
#endif
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic
use numerics, only: &
analyticJaco, &
worldrank, &
numerics_integrator
use math, only: &
math_Mandel3333to66, &
math_Voigt66to3333
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_error, &
IO_timeStamp, &
#ifdef HDF
tempResults, &
HDF5_addGroup, &
HDF5_addScalarDataset,&
#endif
IO_EOF
use material, only: &
phase_plasticity, &
phase_plasticityInstance, &
phase_Noutput, &
PLASTICITY_J2_label, &
PLASTICITY_J2_ID, &
material_phase, &
plasticState, &
MATERIAL_partPhase
use lattice
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
o, &
phase, &
maxNinstance, &
instance, &
mySize, &
sizeDotState, &
sizeState, &
sizeDeltaState
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: NofMyPhase
#ifdef HDF
character(len=5) :: &
str1
integer(HID_T) :: ID,ID2,ID4
#endif
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_J2_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_plasticity == PLASTICITY_J2_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
#ifdef HDF
allocate(plastic_j2_Output2(maxNinstance))
allocate(outID(maxNinstance))
#endif
allocate(plastic_j2_sizePostResults(maxNinstance), source=0_pInt)
allocate(plastic_j2_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt)
allocate(plastic_j2_output(maxval(phase_Noutput), maxNinstance))
plastic_j2_output = ''
allocate(plastic_j2_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(plastic_j2_Noutput(maxNinstance), source=0_pInt)
allocate(plastic_j2_fTaylor(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_tau0(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_gdot0(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_n(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_h0(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_h0_slopeLnRate(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_tausat(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_a(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_aTolResistance(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_aTolShear (maxNinstance), source=0.0_pReal)
allocate(plastic_j2_tausat_SinhFitA(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_tausat_SinhFitB(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_tausat_SinhFitC(maxNinstance), source=0.0_pReal)
allocate(plastic_j2_tausat_SinhFitD(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to <phase>
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

109
src/plastic_none.f90 Normal file
View File

@ -0,0 +1,109 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for purely elastic material
!--------------------------------------------------------------------------------------------------
module plastic_none
use prec, only: &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_none_sizePostResults
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_none_sizePostResult !< size of each post result output
public :: &
plastic_none_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_none_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic
use IO, only: &
IO_timeStamp
use numerics, only: &
worldrank, &
numerics_integrator
use material, only: &
phase_plasticity, &
PLASTICITY_NONE_label, &
material_phase, &
plasticState, &
PLASTICITY_none_ID
implicit none
integer(pInt) :: &
maxNinstance, &
phase, &
NofMyPhase, &
sizeState, &
sizeDotState, &
sizeDeltaState
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
initializeInstances: do phase = 1_pInt, size(phase_plasticity)
if (phase_plasticity(phase) == PLASTICITY_none_ID) then
NofMyPhase=count(material_phase==phase)
sizeState = 0_pInt
plasticState(phase)%sizeState = sizeState
sizeDotState = sizeState
plasticState(phase)%sizeDotState = sizeDotState
sizeDeltaState = 0_pInt
plasticState(phase)%sizeDeltaState = sizeDeltaState
plasticState(phase)%sizePostResults = 0_pInt
plasticState(phase)%nSlip = 0_pInt
plasticState(phase)%nTwin = 0_pInt
plasticState(phase)%nTrans = 0_pInt
allocate(plasticState(phase)%aTolState (sizeState))
allocate(plasticState(phase)%state0 (sizeState,NofMyPhase))
allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase))
allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase))
allocate(plasticState(phase)%state (sizeState,NofMyPhase))
allocate(plasticState(phase)%state_backup (sizeState,NofMyPhase))
allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase))
allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase))
allocate(plasticState(phase)%dotState_backup (sizeDotState,NofMyPhase))
if (any(numerics_integrator == 1_pInt)) then
allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase))
allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase))
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase))
if (any(numerics_integrator == 5_pInt)) &
allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase))
endif
enddo initializeInstances
allocate(plastic_none_sizePostResults(maxNinstance), source=0_pInt)
end subroutine plastic_none_init
end module plastic_none

4031
src/plastic_nonlocal.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

1419
src/plastic_phenoplus.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

1226
src/plastic_phenopowerlaw.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

1913
src/plastic_titanmod.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

61
src/porosity_none.f90 Normal file
View File

@ -0,0 +1,61 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for constant porosity
!--------------------------------------------------------------------------------------------------
module porosity_none
implicit none
private
public :: &
porosity_none_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine porosity_none_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: &
pReal, &
pInt
use IO, only: &
IO_timeStamp
use material
use numerics, only: &
worldrank
implicit none
integer(pInt) :: &
homog, &
NofMyHomog
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_none_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (porosity_type(homog) == POROSITY_none_ID) then
NofMyHomog = count(material_homog == homog)
porosityState(homog)%sizeState = 0_pInt
porosityState(homog)%sizePostResults = 0_pInt
allocate(porosityState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal)
allocate(porosityState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
allocate(porosityState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal)
deallocate(porosity(homog)%p)
allocate (porosity(homog)%p(1), source=porosity_initialPhi(homog))
endif myhomog
enddo initializeInstances
end subroutine porosity_none_init
end module porosity_none

450
src/porosity_phasefield.f90 Normal file
View File

@ -0,0 +1,450 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for phase field modelling of pore nucleation and growth
!> @details phase field model for pore nucleation and growth based on vacancy clustering
!--------------------------------------------------------------------------------------------------
module porosity_phasefield
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
porosity_phasefield_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
porosity_phasefield_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
porosity_phasefield_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
porosity_phasefield_Noutput !< number of outputs per instance of this porosity
enum, bind(c)
enumerator :: undefined_ID, &
porosity_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
porosity_phasefield_outputID !< ID of each post result output
public :: &
porosity_phasefield_init, &
porosity_phasefield_getFormationEnergy, &
porosity_phasefield_getSurfaceEnergy, &
porosity_phasefield_getSourceAndItsTangent, &
porosity_phasefield_getDiffusion33, &
porosity_phasefield_getMobility, &
porosity_phasefield_putPorosity, &
porosity_phasefield_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine porosity_phasefield_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
porosity_type, &
porosity_typeInstance, &
homogenization_Noutput, &
POROSITY_phasefield_label, &
POROSITY_phasefield_ID, &
material_homog, &
mappingHomogenization, &
porosityState, &
porosityMapping, &
porosity, &
porosity_initialPhi, &
material_partHomogenization, &
material_partPhase
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(porosity_phasefield_sizePostResults(maxNinstance), source=0_pInt)
allocate(porosity_phasefield_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(porosity_phasefield_output (maxval(homogenization_Noutput),maxNinstance))
porosity_phasefield_output = ''
allocate(porosity_phasefield_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(porosity_phasefield_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
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

192
src/prec.f90 Normal file
View File

@ -0,0 +1,192 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH
!> @brief setting precision for real and int type depending on makros "FLOAT" and "INT"
!> @details setting precision for real and int type and for DAMASK_NaN. Definition is made
!! depending on makros "FLOAT" and "INT" defined during compilation
!! for details on NaN see https://software.intel.com/en-us/forums/topic/294680
!--------------------------------------------------------------------------------------------------
module prec
#if !(defined(__GFORTRAN__) && __GNUC__ < 5)
use, intrinsic :: & ! unfortunately not avialable in gfortran <= 5
IEEE_arithmetic
#endif
implicit none
private
#if (FLOAT==4)
#if defined(Spectral) || defined(FEM)
SPECTRAL SOLVER AND OWN FEM DO NOT SUPPORT SINGLE PRECISION, STOPPING COMPILATION
#endif
integer, parameter, public :: pReal = 4 !< floating point single precition (was selected_real_kind(6,37), number with 6 significant digits, up to 1e+-37)
#ifdef __INTEL_COMPILER
real(pReal), parameter, public :: DAMASK_NaN = Z'7F800001' !< quiet NaN for single precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html, copy can be found in documentation/Code/Fortran)
#endif
#ifdef __GFORTRAN__
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal) !< quiet NaN for single precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html, copy can be found in documentation/Code/Fortran)
#endif
#elif (FLOAT==8)
integer, parameter, public :: pReal = 8 !< floating point double precision (was selected_real_kind(15,300), number with 15 significant digits, up to 1e+-300)
#ifdef __INTEL_COMPILER
real(pReal), parameter, public :: DAMASK_NaN = Z'7FF8000000000000' !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html, copy can be found in documentation/Code/Fortran)
#endif
#ifdef __GFORTRAN__
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF8000000000000',pReal) !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html, copy can be found in documentation/Code/Fortran)
#endif
#else
NO SUITABLE PRECISION FOR REAL SELECTED, STOPPING COMPILATION
#endif
#if (INT==4)
integer, parameter, public :: pInt = 4 !< integer representation 32 bit (was selected_int_kind(9), number with at least up to +- 1e9)
#elif (INT==8)
integer, parameter, public :: pInt = 8 !< integer representation 64 bit (was selected_int_kind(12), number with at least up to +- 1e12)
#else
NO SUITABLE PRECISION FOR INTEGER SELECTED, STOPPING COMPILATION
#endif
integer, parameter, public :: pLongInt = 8 !< integer representation 64 bit (was selected_int_kind(12), number with at least up to +- 1e12)
real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)
integer(pInt), allocatable, dimension(:) :: realloc_lhs_test
type, public :: p_vec !< variable length datatype used for storage of state
real(pReal), dimension(:), pointer :: p
end type p_vec
type, public :: p_intvec
integer(pInt), dimension(:), pointer :: p
end type p_intvec
!http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array
type, public :: tState
integer(pInt) :: &
sizeState = 0_pInt , & !< size of state
sizeDotState = 0_pInt, & !< size of dot state, i.e. parts of the state that are integrated
sizeDeltaState = 0_pInt, & !< size of delta state, i.e. parts of the state that have discontinuous rates
sizePostResults = 0_pInt !< size of output data
real(pReal), pointer, dimension(:), contiguous :: &
atolState
real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous
state, & !< state
dotState, & !< state rate
state0
real(pReal), allocatable, dimension(:,:) :: &
partionedState0, &
subState0, &
state_backup, &
deltaState, &
previousDotState, & !< state rate of previous xxxx
previousDotState2, & !< state rate two xxxx ago
dotState_backup, & !< backup of state rate
RK4dotState
real(pReal), allocatable, dimension(:,:,:) :: &
RKCK45dotState
end type
type, extends(tState), public :: tPlasticState
integer(pInt) :: &
nSlip = 0_pInt , &
nTwin = 0_pInt, &
nTrans = 0_pInt
logical :: &
nonlocal = .false. !< absolute tolerance for state integration
real(pReal), pointer, dimension(:,:), contiguous :: &
slipRate, & !< slip rate
accumulatedSlip !< accumulated plastic slip
end type
type, public :: tSourceState
type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase
end type
type, public :: tHomogMapping
integer(pInt), pointer, dimension(:,:) :: p
end type
type, public :: tPhaseMapping
integer(pInt), pointer, dimension(:,:,:) :: p
end type
#ifdef FEM
type, public :: tOutputData
integer(pInt) :: &
sizeIpCells = 0_pInt , &
sizeResults = 0_pInt
real(pReal), allocatable, dimension(:,:) :: &
output !< output data
end type
#endif
public :: &
prec_init, &
prec_isNaN
contains
!--------------------------------------------------------------------------------------------------
!> @brief reporting precision and checking if DAMASK_NaN is set correctly
!--------------------------------------------------------------------------------------------------
subroutine prec_init
use, intrinsic :: &
iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
implicit none
integer(pInt) :: worldrank = 0_pInt
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
PetscErrorCode :: ierr
#endif
external :: &
quit, &
MPI_Comm_rank, &
MPI_Abort
#ifdef PETSc
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)
#endif
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- prec init -+>>>'
#include "compilation_info.f90"
write(6,'(a,i3)') ' Bytes for pReal: ',pReal
write(6,'(a,i3)') ' Bytes for pInt: ',pInt
write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt
write(6,'(a,e10.3)') ' NaN: ', DAMASK_NaN
write(6,'(a,l3)') ' NaN != NaN: ',DAMASK_NaN /= DAMASK_NaN
write(6,'(a,l3,/)') ' NaN check passed ',prec_isNAN(DAMASK_NaN)
endif mainProcess
if ((.not. prec_isNaN(DAMASK_NaN)) .or. (DAMASK_NaN == DAMASK_NaN)) call quit(9000)
realloc_lhs_test = [1_pInt,2_pInt]
if (realloc_lhs_test(2)/=2_pInt) call quit(9000)
end subroutine prec_init
!--------------------------------------------------------------------------------------------------
!> @brief figures out if a floating point number is NaN
! basically just a small wrapper, because gfortran < 4.9 does not have the IEEE module
!--------------------------------------------------------------------------------------------------
logical elemental function prec_isNaN(a)
implicit none
real(pReal), intent(in) :: a
#if (defined(__GFORTRAN__) && __GNUC__ < 5)
intrinsic :: isNaN
prec_isNaN = isNaN(a)
#else
prec_isNaN = IEEE_is_NaN(a)
#endif
end function prec_isNaN
end module prec

8
src/quit__genmod.f90 Normal file
View File

@ -0,0 +1,8 @@
!COMPILER-GENERATED INTERFACE MODULE: Thu Mar 3 12:28:23 2016
MODULE QUIT__genmod
INTERFACE
SUBROUTINE QUIT(STOP_ID)
INTEGER(KIND=4), INTENT(IN) :: STOP_ID
END SUBROUTINE QUIT
END INTERFACE
END MODULE QUIT__genmod

425
src/source_damage_anisoBrittle.f90 Normal file
View File

@ -0,0 +1,425 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Luv Sharma, Max-Planck-Institut fŸr Eisenforschung GmbH
!> @author Pratheek Shanthraj, Max-Planck-Institut fŸr Eisenforschung GmbH
!> @brief material subroutine incorporating anisotropic brittle damage source mechanism
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_anisoBrittle
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_anisoBrittle_sizePostResults, & !< cumulative size of post results
source_damage_anisoBrittle_offset, & !< which source is my current source mechanism?
source_damage_anisoBrittle_instance !< instance of source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_damage_anisoBrittle_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_anisoBrittle_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_anisoBrittle_Noutput !< number of outputs per instance of this source
integer(pInt), dimension(:), allocatable, private :: &
source_damage_anisoBrittle_totalNcleavage !< total number of cleavage systems
integer(pInt), dimension(:,:), allocatable, private :: &
source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family
real(pReal), dimension(:), allocatable, private :: &
source_damage_anisoBrittle_aTol, &
source_damage_anisoBrittle_sdot_0, &
source_damage_anisoBrittle_N
real(pReal), dimension(:,:), allocatable, private :: &
source_damage_anisoBrittle_critDisp, &
source_damage_anisoBrittle_critLoad
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_anisoBrittle_outputID !< ID of each post result output
public :: &
source_damage_anisoBrittle_init, &
source_damage_anisoBrittle_dotState, &
source_damage_anisobrittle_getRateAndItsTangent, &
source_damage_anisoBrittle_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoBrittle_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_anisoBrittle_label, &
SOURCE_damage_anisoBrittle_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
use lattice, only: &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoBrittle_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0_pInt)
allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_damage_anisoBrittle_ID) &
source_damage_anisoBrittle_offset(phase) = source
enddo
enddo
allocate(source_damage_anisoBrittle_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),maxNinstance))
source_damage_anisoBrittle_output = ''
allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_anisoBrittle_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_totalNcleavage(maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_aTol(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_sdot_0(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_N(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

415
src/source_damage_anisoDuctile.f90 Normal file
View File

@ -0,0 +1,415 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating anisotropic ductile damage source mechanism
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_anisoDuctile
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_anisoDuctile_sizePostResults, & !< cumulative size of post results
source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_anisoDuctile_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_damage_anisoDuctile_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_anisoDuctile_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_anisoDuctile_Noutput !< number of outputs per instance of this damage
integer(pInt), dimension(:), allocatable, private :: &
source_damage_anisoDuctile_totalNslip !< total number of slip systems
integer(pInt), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_Nslip !< number of slip systems per family
real(pReal), dimension(:), allocatable, private :: &
source_damage_anisoDuctile_aTol
real(pReal), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_critPlasticStrain
real(pReal), dimension(:), allocatable, private :: &
source_damage_anisoDuctile_sdot_0, &
source_damage_anisoDuctile_N
real(pReal), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_critLoad
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_outputID !< ID of each post result output
public :: &
source_damage_anisoDuctile_init, &
source_damage_anisoDuctile_dotState, &
source_damage_anisoDuctile_getRateAndItsTangent, &
source_damage_anisoDuctile_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_anisoDuctile_label, &
SOURCE_damage_anisoDuctile_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoDuctile_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_damage_anisoDuctile_offset(material_Nphase), source=0_pInt)
allocate(source_damage_anisoDuctile_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_damage_anisoDuctile_ID) &
source_damage_anisoDuctile_offset(phase) = source
enddo
enddo
allocate(source_damage_anisoDuctile_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),maxNinstance))
source_damage_anisoDuctile_output = ''
allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_anisoDuctile_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal)
allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_totalNslip(maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_N(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoDuctile_sdot_0(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoDuctile_aTol(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

383
src/source_damage_isoBrittle.f90 Normal file
View File

@ -0,0 +1,383 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incoprorating isotropic brittle damage source mechanism
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_isoBrittle
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_isoBrittle_sizePostResults, & !< cumulative size of post results
source_damage_isoBrittle_offset, & !< which source is my current damage mechanism?
source_damage_isoBrittle_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_damage_isoBrittle_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_isoBrittle_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_damage_isoBrittle_aTol, &
source_damage_isoBrittle_N, &
source_damage_isoBrittle_critStrainEnergy
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_isoBrittle_outputID !< ID of each post result output
public :: &
source_damage_isoBrittle_init, &
source_damage_isoBrittle_deltaState, &
source_damage_isoBrittle_getRateAndItsTangent, &
source_damage_isoBrittle_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_isoBrittle_label, &
SOURCE_damage_isoBrittle_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoBrittle_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_damage_isoBrittle_offset(material_Nphase), source=0_pInt)
allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_damage_isoBrittle_ID) &
source_damage_isoBrittle_offset(phase) = source
enddo
enddo
allocate(source_damage_isoBrittle_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),maxNinstance))
source_damage_isoBrittle_output = ''
allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_isoBrittle_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_isoBrittle_critStrainEnergy(maxNinstance), source=0.0_pReal)
allocate(source_damage_isoBrittle_N(maxNinstance), source=1.0_pReal)
allocate(source_damage_isoBrittle_aTol(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

350
src/source_damage_isoDuctile.f90 Normal file
View File

@ -0,0 +1,350 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut fŸr Eisenforschung GmbH
!> @author Luv Sharma, Max-Planck-Institut fŸr Eisenforschung GmbH
!> @brief material subroutine incoprorating isotropic ductile damage source mechanism
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_isoDuctile
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_isoDuctile_sizePostResults, & !< cumulative size of post results
source_damage_isoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_isoDuctile_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_damage_isoDuctile_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_isoDuctile_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_damage_isoDuctile_aTol, &
source_damage_isoDuctile_critPlasticStrain, &
source_damage_isoDuctile_N
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_isoDuctile_outputID !< ID of each post result output
public :: &
source_damage_isoDuctile_init, &
source_damage_isoDuctile_dotState, &
source_damage_isoDuctile_getRateAndItsTangent, &
source_damage_isoDuctile_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_isoDuctile_label, &
SOURCE_damage_isoDuctile_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoDuctile_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt)
allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_damage_isoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoDuctile_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_damage_isoDuctile_ID) &
source_damage_isoDuctile_offset(phase) = source
enddo
enddo
allocate(source_damage_isoDuctile_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),maxNinstance))
source_damage_isoDuctile_output = ''
allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_isoDuctile_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_isoDuctile_critPlasticStrain(maxNinstance), source=0.0_pReal)
allocate(source_damage_isoDuctile_N(maxNinstance), source=0.0_pReal)
allocate(source_damage_isoDuctile_aTol(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

220
src/source_thermal_dissipation.f90 Normal file
View File

@ -0,0 +1,220 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for thermal source due to plastic dissipation
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_thermal_dissipation
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_thermal_dissipation_sizePostResults, & !< cumulative size of post results
source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism?
source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_thermal_dissipation_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_thermal_dissipation_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_thermal_dissipation_Noutput !< number of outputs per instance of this source
real(pReal), dimension(:), allocatable, private :: &
source_thermal_dissipation_coldworkCoeff
public :: &
source_thermal_dissipation_init, &
source_thermal_dissipation_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_thermal_dissipation_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_thermal_dissipation_label, &
SOURCE_thermal_dissipation_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_thermal_dissipation_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_thermal_dissipation_offset(material_Nphase), source=0_pInt)
allocate(source_thermal_dissipation_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_thermal_dissipation_instance(phase) = count(phase_source(:,1:phase) == SOURCE_thermal_dissipation_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == SOURCE_thermal_dissipation_ID) &
source_thermal_dissipation_offset(phase) = source
enddo
enddo
allocate(source_thermal_dissipation_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_thermal_dissipation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_thermal_dissipation_output (maxval(phase_Noutput),maxNinstance))
source_thermal_dissipation_output = ''
allocate(source_thermal_dissipation_Noutput(maxNinstance), source=0_pInt)
allocate(source_thermal_dissipation_coldworkCoeff(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

277
src/source_thermal_externalheat.f90 Normal file
View File

@ -0,0 +1,277 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for thermal source due to plastic dissipation
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_thermal_externalheat
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_thermal_externalheat_sizePostResults, & !< cumulative size of post results
source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism?
source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_thermal_externalheat_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_thermal_externalheat_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_thermal_externalheat_Noutput !< number of outputs per instance of this source
integer(pInt), dimension(:), allocatable, private :: &
source_thermal_externalheat_nIntervals
real(pReal), dimension(:,:), allocatable, private :: &
source_thermal_externalheat_time, &
source_thermal_externalheat_rate
public :: &
source_thermal_externalheat_init, &
source_thermal_externalheat_dotState, &
source_thermal_externalheat_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_thermal_externalheat_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_thermal_externalheat_label, &
SOURCE_thermal_externalheat_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase,interval
character(len=65536) :: &
tag = '', &
line = ''
real(pReal), allocatable, dimension(:,:) :: temp_time, temp_rate
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_thermal_externalheat_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_thermal_externalheat_offset(material_Nphase), source=0_pInt)
allocate(source_thermal_externalheat_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_thermal_externalheat_instance(phase) = count(phase_source(:,1:phase) == SOURCE_thermal_externalheat_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == SOURCE_thermal_externalheat_ID) &
source_thermal_externalheat_offset(phase) = source
enddo
enddo
allocate(source_thermal_externalheat_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_thermal_externalheat_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_thermal_externalheat_output (maxval(phase_Noutput),maxNinstance))
source_thermal_externalheat_output = ''
allocate(source_thermal_externalheat_Noutput(maxNinstance), source=0_pInt)
allocate(source_thermal_externalheat_nIntervals(maxNinstance), source=0_pInt)
allocate(temp_time(maxNinstance,1000), source=0.0_pReal)
allocate(temp_rate(maxNinstance,1000), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

253
src/source_vacancy_irradiation.f90 Normal file
View File

@ -0,0 +1,253 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for vacancy generation due to irradiation
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_vacancy_irradiation
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_vacancy_irradiation_sizePostResults, & !< cumulative size of post results
source_vacancy_irradiation_offset, & !< which source is my current damage mechanism?
source_vacancy_irradiation_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_vacancy_irradiation_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_vacancy_irradiation_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_vacancy_irradiation_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_vacancy_irradiation_cascadeProb, &
source_vacancy_irradiation_cascadeVolume
public :: &
source_vacancy_irradiation_init, &
source_vacancy_irradiation_deltaState, &
source_vacancy_irradiation_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_irradiation_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_vacancy_irradiation_label, &
SOURCE_vacancy_irradiation_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_irradiation_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_vacancy_irradiation_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_vacancy_irradiation_offset(material_Nphase), source=0_pInt)
allocate(source_vacancy_irradiation_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_vacancy_irradiation_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_irradiation_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_vacancy_irradiation_ID) &
source_vacancy_irradiation_offset(phase) = source
enddo
enddo
allocate(source_vacancy_irradiation_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_vacancy_irradiation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_vacancy_irradiation_output(maxval(phase_Noutput),maxNinstance))
source_vacancy_irradiation_output = ''
allocate(source_vacancy_irradiation_Noutput(maxNinstance), source=0_pInt)
allocate(source_vacancy_irradiation_cascadeProb(maxNinstance), source=0.0_pReal)
allocate(source_vacancy_irradiation_cascadeVolume(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

215
src/source_vacancy_phenoplasticity.f90 Normal file
View File

@ -0,0 +1,215 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for vacancy generation due to plasticity
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_vacancy_phenoplasticity
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_vacancy_phenoplasticity_sizePostResults, & !< cumulative size of post results
source_vacancy_phenoplasticity_offset, & !< which source is my current damage mechanism?
source_vacancy_phenoplasticity_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_vacancy_phenoplasticity_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_vacancy_phenoplasticity_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_vacancy_phenoplasticity_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_vacancy_phenoplasticity_rateCoeff
public :: &
source_vacancy_phenoplasticity_init, &
source_vacancy_phenoplasticity_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_phenoplasticity_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_vacancy_phenoplasticity_label, &
SOURCE_vacancy_phenoplasticity_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_phenoplasticity_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_vacancy_phenoplasticity_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_vacancy_phenoplasticity_offset(material_Nphase), source=0_pInt)
allocate(source_vacancy_phenoplasticity_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_vacancy_phenoplasticity_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_phenoplasticity_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_vacancy_phenoplasticity_ID) &
source_vacancy_phenoplasticity_offset(phase) = source
enddo
enddo
allocate(source_vacancy_phenoplasticity_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_vacancy_phenoplasticity_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_vacancy_phenoplasticity_output(maxval(phase_Noutput),maxNinstance))
source_vacancy_phenoplasticity_output = ''
allocate(source_vacancy_phenoplasticity_Noutput(maxNinstance), source=0_pInt)
allocate(source_vacancy_phenoplasticity_rateCoeff(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

255
src/source_vacancy_thermalfluc.f90 Normal file
View File

@ -0,0 +1,255 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for vacancy generation due to thermal fluctuations
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_vacancy_thermalfluc
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_vacancy_thermalfluc_sizePostResults, & !< cumulative size of post results
source_vacancy_thermalfluc_offset, & !< which source is my current damage mechanism?
source_vacancy_thermalfluc_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_vacancy_thermalfluc_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_vacancy_thermalfluc_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_vacancy_thermalfluc_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_vacancy_thermalfluc_amplitude, &
source_vacancy_thermalfluc_normVacancyEnergy
public :: &
source_vacancy_thermalfluc_init, &
source_vacancy_thermalfluc_deltaState, &
source_vacancy_thermalfluc_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_thermalfluc_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use lattice, only: &
lattice_vacancyFormationEnergy
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_vacancy_thermalfluc_label, &
SOURCE_vacancy_thermalfluc_ID, &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
analyticJaco, &
worldrank, &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_thermalfluc_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_source == SOURCE_vacancy_thermalfluc_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_vacancy_thermalfluc_offset(material_Nphase), source=0_pInt)
allocate(source_vacancy_thermalfluc_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_vacancy_thermalfluc_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_thermalfluc_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_vacancy_thermalfluc_ID) &
source_vacancy_thermalfluc_offset(phase) = source
enddo
enddo
allocate(source_vacancy_thermalfluc_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_vacancy_thermalfluc_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_vacancy_thermalfluc_output(maxval(phase_Noutput),maxNinstance))
source_vacancy_thermalfluc_output = ''
allocate(source_vacancy_thermalfluc_Noutput(maxNinstance), source=0_pInt)
allocate(source_vacancy_thermalfluc_amplitude(maxNinstance), source=0.0_pReal)
allocate(source_vacancy_thermalfluc_normVacancyEnergy(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
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

414
src/spectral_damage.f90 Normal file
View File

@ -0,0 +1,414 @@
!--------------------------------------------------------------------------------------------------
! $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 <petsc/finclude/petsc.h90>
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

568
src/spectral_interface.f90 Normal file
View File

@ -0,0 +1,568 @@
!--------------------------------------------------------------------------------------------------
! $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 <petsc/finclude/petscsys.h>
#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

715
src/spectral_mech_AL.f90 Normal file
View File

@ -0,0 +1,715 @@
!--------------------------------------------------------------------------------------------------
! $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 <petsc/finclude/petsc.h90>
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

569
src/spectral_mech_Basic.f90 Normal file
View File

@ -0,0 +1,569 @@
!--------------------------------------------------------------------------------------------------
! $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 <petsc/finclude/petsc.h90>
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

712
src/spectral_mech_Polarisation.f90 Normal file
View File

@ -0,0 +1,712 @@
!--------------------------------------------------------------------------------------------------
! $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 <petsc/finclude/petsc.h90>
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

419
src/spectral_thermal.f90 Normal file
View File

@ -0,0 +1,419 @@
!--------------------------------------------------------------------------------------------------
! $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 <petsc/finclude/petsc.h90>
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

1262
src/spectral_utilities.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

422
src/thermal_adiabatic.f90 Normal file
View File

@ -0,0 +1,422 @@
!--------------------------------------------------------------------------------------------------
! $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 <homogenization>
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

444
src/thermal_conduction.f90 Normal file
View File

@ -0,0 +1,444 @@
!--------------------------------------------------------------------------------------------------
! $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 <homogenization>
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

65
src/thermal_isothermal.f90 Normal file
View File

@ -0,0 +1,65 @@
!--------------------------------------------------------------------------------------------------
! $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

606
src/vacancyflux_cahnhilliard.f90 Normal file
View File

@ -0,0 +1,606 @@
!--------------------------------------------------------------------------------------------------
! $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 <homogenization>
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

329
src/vacancyflux_isochempot.f90 Normal file
View File

@ -0,0 +1,329 @@
!--------------------------------------------------------------------------------------------------
! $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 <homogenization>
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

63
src/vacancyflux_isoconc.f90 Normal file
View File

@ -0,0 +1,63 @@
!--------------------------------------------------------------------------------------------------
! $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