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

Merge branch 'marc-mesh-simplification' into development

This commit is contained in:
Martin Diehl 2019-06-13 20:52:34 +02:00
parent 92e6d0a5ee 47df2b581e
commit 589f534334
53 changed files with 4124 additions and 6163 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PRIVATE

@ -1 +1 @@
Subproject commit 64cda1c010d500f662cd9a298c7b7ad10ab91c3c
Subproject commit 93bc0c8a1de2944add043b58159bf9b6e4193752

2
python/damask/test/test.py
View File

@ -267,7 +267,7 @@ class Test():
logging.critical('Current2Current: Unable to copy file "{}"'.format(f))
raise
def execute_inCurrentDir(self,cmd,streamIn=None):
def execute_inCurrentDir(self,cmd,streamIn=None,env=None):
logging.info(cmd)
out,error = damask.util.execute(cmd,streamIn,self.dirCurrent())

7
python/damask/util.py
View File

@ -97,14 +97,17 @@ def strikeout(what):
# -----------------------------
def execute(cmd,
streamIn = None,
wd = './'):
wd = './',
env = None):
"""Executes a command in given directory and returns stdout and stderr for optional stdin"""
initialPath = os.getcwd()
os.chdir(wd)
myEnv = os.environ if env is None else env
process = subprocess.Popen(shlex.split(cmd),
stdout = subprocess.PIPE,
stderr = subprocess.PIPE,
stdin = subprocess.PIPE)
stdin = subprocess.PIPE,
env = myEnv)
out,error = [i for i in (process.communicate() if streamIn is None
else process.communicate(streamIn.read().encode('utf-8')))]
out = out.decode('utf-8').replace('\x08','')

191
src/CPFEM.f90
View File

@ -5,9 +5,27 @@
!--------------------------------------------------------------------------------------------------
module CPFEM
use prec
use numerics
use debug
use FEsolving
use math
use mesh
use material
use config
use crystallite
use homogenization
use IO
use discretization
use DAMASK_interface
use numerics
use HDF5_utilities
use results
use lattice
use constitutive
implicit none
private
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
@ -55,38 +73,6 @@ contains
!> @brief call (thread safe) all module initializations
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll(el,ip)
use numerics, only: &
numerics_init
use debug, only: &
debug_init
use config, only: &
config_init
use FEsolving, only: &
FE_init
use math, only: &
math_init
use mesh, only: &
mesh_init
use material, only: &
material_init
#ifdef DAMASK_HDF5
use HDF5_utilities, only: &
HDF5_utilities_init
use results, only: &
results_init
#endif
use lattice, only: &
lattice_init
use constitutive, only: &
constitutive_init
use crystallite, only: &
crystallite_init
use homogenization, only: &
homogenization_init
use IO, only: &
IO_init
use DAMASK_interface
integer(pInt), intent(in) :: el, & !< FE el number
ip !< FE integration point number
@ -100,12 +86,12 @@ subroutine CPFEM_initAll(el,ip)
call config_init
call math_init
call FE_init
call mesh_init(ip, el)
call lattice_init
#ifdef DAMASK_HDF5
call HDF5_utilities_init
call results_init
#endif
call mesh_init(ip, el)
call lattice_init
call material_init
call constitutive_init
call crystallite_init
@ -122,42 +108,15 @@ end subroutine CPFEM_initAll
!> @brief allocate the arrays defined in module CPFEM and initialize them
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_init
use IO, only: &
IO_error
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive
use FEsolving, only: &
symmetricSolver, &
restartRead, &
modelName
use mesh, only: &
theMesh
use material, only: &
material_phase, &
homogState, &
phase_plasticity, &
plasticState
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
crystallite_Fp0, &
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_S0
integer :: k,l,m,ph,homog
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
flush(6)
allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
allocate(CPFEM_cs( 6,discretization_nIP,discretization_nElem), source= 0.0_pReal)
allocate(CPFEM_dcsdE( 6,6,discretization_nIP,discretization_nElem), source= 0.0_pReal)
allocate(CPFEM_dcsdE_knownGood(6,6,discretization_nIP,discretization_nElem), source= 0.0_pReal)
! *** restore the last converged values of each essential variable from the binary file
!if (restartRead) then
@ -238,86 +197,6 @@ end subroutine CPFEM_init
!> @brief perform initialization at first call, update variables and call the actual material model
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyStress, jacobian)
use numerics, only: &
defgradTolerance, &
iJacoStiffness
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective, &
debug_stressMaxLocation, &
debug_stressMinLocation, &
debug_jacobianMaxLocation, &
debug_jacobianMinLocation, &
debug_stressMax, &
debug_stressMin, &
debug_jacobianMax, &
debug_jacobianMin, &
debug_e, &
debug_i
use FEsolving, only: &
terminallyIll, &
FEsolving_execElem, &
FEsolving_execIP, &
restartWrite
use math, only: &
math_identity2nd, &
math_det33, &
math_delta, &
math_sym3333to66, &
math_66toSym3333, &
math_sym33to6, &
math_6toSym33
use mesh, only: &
mesh_FEasCP, &
theMesh, &
mesh_element
use material, only: &
microstructure_elemhomo, &
plasticState, &
sourceState, &
homogState, &
thermalState, &
damageState, &
phaseAt, phasememberAt, &
material_phase, &
phase_plasticity, &
temperature, &
thermalMapping, &
thermal_type, &
THERMAL_conduction_ID, &
phase_Nsources, &
material_homogenizationAt
use config, only: &
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_dPdF, &
crystallite_S0, &
crystallite_S
use homogenization, only: &
materialpoint_F, &
materialpoint_F0, &
materialpoint_P, &
materialpoint_dPdF, &
materialpoint_results, &
materialpoint_sizeResults, &
materialpoint_stressAndItsTangent, &
materialpoint_postResults
use IO, only: &
IO_warning
use DAMASK_interface
integer(pInt), intent(in) :: elFE, & !< FE element number
ip !< integration point number
@ -380,7 +259,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
enddo; enddo
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
write(6,'(a)') '<< CPFEM >> aging states'
if (debug_e <= theMesh%Nelems .and. debug_i <= theMesh%elem%nIPs) then
if (debug_e <= discretization_nElem .and. debug_i <=discretization_nIP) 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))
@ -464,7 +343,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
!* If no parallel execution is required, there is no need to collect FEM input
if (.not. parallelExecution) then
chosenThermal1: select case (thermal_type(mesh_element(3,elCP)))
chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP)))
case (THERMAL_conduction_ID) chosenThermal1
temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
temperature_inp
@ -477,7 +356,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
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)
chosenThermal2: select case (thermal_type(mesh_element(3,elCP)))
chosenThermal2: select case (thermal_type(material_homogenizationAt(elCP)))
case (THERMAL_conduction_ID) chosenThermal2
temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
temperature_inp
@ -520,15 +399,12 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
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
@ -551,13 +427,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
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 = matmul(materialpoint_P(1:3,1:3,ip,elCP), transpose(materialpoint_F(1:3,1:3,ip,elCP)))
@ -632,14 +501,6 @@ end subroutine CPFEM_general
!> @brief triggers writing of the results
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_results(inc,time)
#ifdef DAMASK_HDF5
use results
use HDF5_utilities
#endif
use constitutive, only: &
constitutive_results
use crystallite, only: &
crystallite_results
integer(pInt), intent(in) :: inc
real(pReal), intent(in) :: time

150
src/CPFEM2.f90
View File

@ -4,6 +4,27 @@
!> @brief needs a good name and description
!--------------------------------------------------------------------------------------------------
module CPFEM2
use prec
use numerics
use debug
use config
use FEsolving
use math
use mesh
use material
use lattice
use IO
use HDF5
use DAMASK_interface
use results
use discretization
use HDF5_utilities
use homogenization
use constitutive
use crystallite
#ifdef FEM
use FEM_Zoo
#endif
implicit none
private
@ -19,43 +40,7 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief call (thread safe) all module initializations
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll()
use prec, only: &
prec_init
use numerics, only: &
numerics_init
use debug, only: &
debug_init
use config, only: &
config_init
use FEsolving, only: &
FE_init
use math, only: &
math_init
use mesh, only: &
mesh_init
use material, only: &
material_init
use HDF5_utilities, only: &
HDF5_utilities_init
use results, only: &
results_init
use lattice, only: &
lattice_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 FEM_Zoo, only: &
FEM_Zoo_init
#endif
subroutine CPFEM_initAll
call DAMASK_interface_init ! Spectral and FEM interface to commandline
call prec_init
@ -85,41 +70,6 @@ end subroutine CPFEM_initAll
!> @brief allocate the arrays defined in module CPFEM and initialize them
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_init
use IO, only: &
IO_error
use numerics, only: &
worldrank
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive
use FEsolving, only: &
restartRead
use material, only: &
material_phase, &
homogState, &
phase_plasticity, &
plasticState
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
crystallite_Fp0, &
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_S0
use hdf5
use HDF5_utilities, only: &
HDF5_openFile, &
HDF5_closeFile, &
HDF5_openGroup, &
HDF5_closeGroup, &
HDF5_read
use DAMASK_interface, only: &
getSolverJobName
integer :: ph,homog
character(len=1024) :: rankStr, PlasticItem, HomogItem
@ -172,52 +122,7 @@ end subroutine CPFEM_init
!--------------------------------------------------------------------------------------------------
!> @brief forwards data after successful increment
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_age()
use prec, only: &
pReal
use numerics, only: &
worldrank
use debug, only: &
debug_level, &
debug_CPFEM, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective
use FEsolving, only: &
restartWrite
use material, only: &
plasticState, &
sourceState, &
homogState, &
thermalState, &
damageState, &
material_phase, &
phase_plasticity, &
phase_Nsources
use config, only: &
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_S0, &
crystallite_S
use HDF5_utilities, only: &
HDF5_openFile, &
HDF5_closeFile, &
HDF5_addGroup, &
HDF5_closeGroup, &
HDF5_write
use hdf5
use DAMASK_interface, only: &
getSolverJobName
subroutine CPFEM_age
integer :: i, ph, homog, mySource
character(len=32) :: rankStr, PlasticItem, HomogItem
@ -289,14 +194,6 @@ end subroutine CPFEM_age
!> @brief triggers writing of the results
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_results(inc,time)
use results
use HDF5_utilities
use homogenization, only: &
homogenization_results
use constitutive, only: &
constitutive_results
use crystallite, only: &
crystallite_results
integer, intent(in) :: inc
real(pReal), intent(in) :: time
@ -306,6 +203,7 @@ subroutine CPFEM_results(inc,time)
call constitutive_results
call crystallite_results
call homogenization_results
call discretization_results
call results_removeLink('current') ! ToDo: put this into closeJobFile
call results_closeJobFile

6
src/DAMASK_interface.f90
View File

@ -40,12 +40,6 @@ module DAMASK_interface
setSIGTERM, &
setSIGUSR1, &
setSIGUSR2
private :: &
setWorkingDirectory, &
getGeometryFile, &
getLoadCaseFile, &
rectifyPath, &
makeRelativePath
contains

100
src/DAMASK_marc.f90
View File

@ -29,9 +29,18 @@
#include "prec.f90"
module DAMASK_interface
use prec
#if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use ifport, only: &
CHDIR
implicit none
private
character(len=4), parameter, public :: InputFileExtension = '.dat'
character(len=4), parameter, public :: LogFileExtension = '.log'
@ -45,15 +54,7 @@ contains
!> @brief reports and sets working directory
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
#if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use ifport, only: &
CHDIR
implicit none
integer, dimension(8) :: &
dateAndTime
integer :: ierr
@ -96,9 +97,7 @@ end subroutine DAMASK_interface_init
!> @brief solver job name (no extension) as combination of geometry and load case name
!--------------------------------------------------------------------------------------------------
function getSolverJobName()
use prec
implicit none
character(1024) :: getSolverJobName, inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
integer :: extPos
@ -115,8 +114,6 @@ end function getSolverJobName
end module DAMASK_interface
#include "commercialFEM_fileList.f90"
!--------------------------------------------------------------------------------------------------
@ -132,47 +129,11 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
jtype,lclass,ifr,ifu)
use prec
use numerics, only: &
!$ DAMASK_NumThreadsInt, &
numerics_unitlength, &
usePingPong
use FEsolving, only: &
calcMode, &
terminallyIll, &
symmetricSolver
use debug, only: &
debug_level, &
debug_LEVELBASIC, &
debug_MARC, &
debug_info, &
debug_reset
use mesh, only: &
theMesh, &
mesh_FEasCP, &
mesh_element, &
mesh_node0, &
mesh_node, &
mesh_Ncellnodes, &
mesh_cellnode, &
mesh_build_cellnodes, &
mesh_build_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, &
lastLovl
use numerics
use FEsolving
use debug
use mesh
use CPFEM
implicit none
!$ include "omp_lib.h" ! the openMP function library
@ -304,7 +265,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
call debug_reset() ! resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
mesh_cellnode = mesh_build_cellnodes() ! update cell node coordinates
call mesh_build_ipCoordinates() ! update ip coordinates
endif
if (outdatedByNewInc) then
@ -319,10 +280,10 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence
lastIncConverged = .false. ! reset flag
endif
do node = 1,theMesh%elem%nNodes
CPnodeID = mesh_element(4+node,cp_en)
mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
enddo
!do node = 1,theMesh%elem%nNodes
!CPnodeID = mesh_element(4+node,cp_en)
!mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
!enddo
endif
else ! --- PLAIN MODE ---
@ -333,8 +294,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
call debug_reset() ! and resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
call mesh_build_ipCoordinates() ! update ip coordinates
!mesh_cellnode = mesh_build_cellnodes() ! update cell node coordinates
!call mesh_build_ipCoordinates() ! update ip coordinates
endif
if (outdatedByNewInc) then
computationMode = ior(computationMode,CPFEM_AGERESULTS)
@ -373,10 +334,8 @@ end subroutine hypela2
!--------------------------------------------------------------------------------------------------
subroutine flux(f,ts,n,time)
use prec
use thermal_conduction, only: &
thermal_conduction_getSourceAndItsTangent
use mesh, only: &
mesh_FEasCP
use thermal_conduction
use mesh
implicit none
real(pReal), dimension(6), intent(in) :: &
@ -399,8 +358,7 @@ subroutine flux(f,ts,n,time)
!--------------------------------------------------------------------------------------------------
subroutine uedinc(inc,incsub)
use prec
use CPFEM, only: &
CPFEM_results
use CPFEM
implicit none
integer, intent(in) :: inc, incsub
@ -417,13 +375,9 @@ end subroutine uedinc
!--------------------------------------------------------------------------------------------------
subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
use prec
use mesh, only: &
mesh_FEasCP
use IO, only: &
IO_error
use homogenization, only: &
materialpoint_results,&
materialpoint_sizeResults
use mesh
use IO
use homogenization
implicit none
integer, intent(in) :: &

20
src/FEsolving.f90
View File

@ -6,6 +6,9 @@
!--------------------------------------------------------------------------------------------------
module FEsolving
use prec
use debug
use IO
use DAMASK_interface
implicit none
private
@ -41,21 +44,6 @@ contains
!> solver the information is provided by the interface module
!--------------------------------------------------------------------------------------------------
subroutine FE_init
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
use DAMASK_interface
#if defined(Marc4DAMASK) || defined(Abaqus)
integer, parameter :: &
@ -121,7 +109,7 @@ subroutine FE_init
.and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) &
modelName = IO_StringValue(line,chunkPos,6)
enddo
#else ! QUESTION: is this meaningful for the spectral/FEM case?
#else
call IO_open_inputFile(FILEUNIT,modelName)
rewind(FILEUNIT)
do

316
src/HDF5_utilities.f90
View File

@ -5,20 +5,24 @@
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!--------------------------------------------------------------------------------------------------
module HDF5_utilities
use prec
use IO
#if defined(PETSc) || defined(DAMASK_HDF5)
use HDF5
use rotations
use numerics
#endif
#ifdef PETSc
use PETSC
#endif
use prec
use IO
use rotations
use numerics
implicit none
public
#if defined(PETSc) || defined(DAMASK_HDF5)
!--------------------------------------------------------------------------------------------------
!> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong
!> @brief reads integer or float data of defined shape from file ! ToDo: order of arguments wrong
!> @details for parallel IO, all dimension except for the last need to match
!--------------------------------------------------------------------------------------------------
interface HDF5_read
@ -41,7 +45,7 @@ module HDF5_utilities
end interface HDF5_read
!--------------------------------------------------------------------------------------------------
!> @brief writes pInt or pReal data of defined shape to file ! ToDo: order of arguments wrong
!> @brief writes integer or real data of defined shape to file ! ToDo: order of arguments wrong
!> @details for parallel IO, all dimension except for the last need to match
!--------------------------------------------------------------------------------------------------
interface HDF5_write
@ -66,7 +70,7 @@ module HDF5_utilities
end interface HDF5_write
!--------------------------------------------------------------------------------------------------
!> @brief attached attributes of type char,pInt or pReal to a file/dataset/group
!> @brief attached attributes of type char, integer or real to a file/dataset/group
!--------------------------------------------------------------------------------------------------
interface HDF5_addAttribute
module procedure HDF5_addAttribute_str
@ -111,7 +115,7 @@ subroutine HDF5_utilities_init
call h5tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr)
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5tget_size_f (int)')
if (int(bit_size(0),SIZE_T)/=typeSize*8) &
call IO_error(0_pInt,ext_msg='Default integer size does not match H5T_NATIVE_INTEGER')
call IO_error(0,ext_msg='Default integer size does not match H5T_NATIVE_INTEGER')
call h5tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr)
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5tget_size_f (double)')
@ -141,30 +145,30 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel) ! ToDo: simply "op
endif
call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pcreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pcreate_f')
#ifdef PETSc
if (present(parallel)) then; if (parallel) then
call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pset_fapl_mpio_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pset_fapl_mpio_f')
endif; endif
#endif
if (m == 'w') then
call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f (w)')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fcreate_f (w)')
elseif(m == 'a') then
call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (a)')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f (a)')
elseif(m == 'r') then
call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (r)')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f (r)')
else
call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode: '//trim(m))
call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f unknown access mode: '//trim(m))
endif
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pclose_f')
end function HDF5_openFile
@ -179,7 +183,7 @@ subroutine HDF5_closeFile(fileHandle)
integer :: hdferr
call h5fclose_f(fileHandle,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeFile: h5fclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_closeFile: h5fclose_f')
end subroutine HDF5_closeFile
@ -198,19 +202,19 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
!-------------------------------------------------------------------------------------------------
! creating a property list for data access properties
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pcreate_f ('//trim(groupName)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5pcreate_f ('//trim(groupName)//')')
!-------------------------------------------------------------------------------------------------
! setting I/O mode to collective
#ifdef PETSc
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
#endif
!-------------------------------------------------------------------------------------------------
! Create group
call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(groupName)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(groupName)//')')
call h5pclose_f(aplist_id,hdferr)
@ -234,19 +238,19 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName)
!-------------------------------------------------------------------------------------------------
! creating a property list for data access properties
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pcreate_f ('//trim(groupName)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5pcreate_f ('//trim(groupName)//')')
!-------------------------------------------------------------------------------------------------
! setting I/O mode to collective
#ifdef PETSc
call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
#endif
!-------------------------------------------------------------------------------------------------
! opening the group
call h5gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(groupName)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(groupName)//')')
call h5pclose_f(aplist_id,hdferr)
@ -262,7 +266,7 @@ subroutine HDF5_closeGroup(group_id)
integer :: hdferr
call h5gclose_f(group_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id,pInt))
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id))
end subroutine HDF5_closeGroup
@ -285,11 +289,11 @@ logical function HDF5_objectExists(loc_id,path)
endif
call h5lexists_f(loc_id, p, HDF5_objectExists, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
if(HDF5_objectExists) then
call h5oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
endif
end function HDF5_objectExists
@ -316,27 +320,27 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5screate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5screate_f')
call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tcopy_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tcopy_f')
call h5tset_size_f(type_id, int(len(trim(attrValue)),HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tset_size_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tset_size_f')
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5aexists_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5aexists_by_name_f')
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5adelete_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5adelete_by_name_f')
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5acreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5acreate_f')
call h5awrite_f(attr_id, type_id, trim(attrValue), int([1],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5awrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5awrite_f')
call h5aclose_f(attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5aclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5aclose_f')
call h5tclose_f(type_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tclose_f')
call h5sclose_f(space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5sclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5sclose_f')
end subroutine HDF5_addAttribute_str
@ -348,7 +352,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel
integer(pInt), intent(in) :: attrValue
integer, intent(in) :: attrValue
character(len=*), intent(in), optional :: path
integer :: hdferr
@ -363,21 +367,21 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5screate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5screate_f')
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5aexists_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5aexists_by_name_f')
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5adelete_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5adelete_by_name_f')
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5acreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5acreate_f')
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5awrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5awrite_f')
call h5aclose_f(attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5tclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5tclose_f')
call h5sclose_f(space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5sclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5sclose_f')
end subroutine HDF5_addAttribute_int
@ -404,21 +408,21 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5screate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5screate_f')
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5aexists_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5aexists_by_name_f')
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5adelete_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5adelete_by_name_f')
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5acreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5acreate_f')
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5awrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5awrite_f')
call h5aclose_f(attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5tclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5tclose_f')
call h5sclose_f(space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5sclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5sclose_f')
end subroutine HDF5_addAttribute_real
@ -430,7 +434,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel
integer(pInt), intent(in), dimension(:) :: attrValue
integer, intent(in), dimension(:) :: attrValue
character(len=*), intent(in), optional :: path
integer :: hdferr
@ -448,21 +452,21 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
array_size = size(attrValue,kind=HSIZE_T)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
call h5aclose_f(attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
call h5sclose_f(space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
end subroutine HDF5_addAttribute_int_array
@ -492,21 +496,21 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
array_size = size(attrValue,kind=HSIZE_T)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
call h5aclose_f(attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
call h5sclose_f(space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
end subroutine HDF5_addAttribute_real_array
@ -522,19 +526,19 @@ subroutine HDF5_setLink(loc_id,target_name,link_name)
logical :: linkExists
call h5lexists_f(loc_id, link_name,linkExists, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link_name)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link_name)//')')
if (linkExists) then
call h5ldelete_f(loc_id,link_name, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link_name)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link_name)//')')
endif
call h5lcreate_soft_f(target_name, loc_id, link_name, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(target_name)//' '//trim(link_name)//')')
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(target_name)//' '//trim(link_name)//')')
end subroutine HDF5_setLink
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 1 dimension
!> @brief read dataset of type real with 1 dimension
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real1(loc_id,dataset,datasetName,parallel)
@ -567,14 +571,14 @@ subroutine HDF5_read_real1(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real1: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real1: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real1
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 2 dimensions
!> @brief read dataset of type real with 2 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real2(loc_id,dataset,datasetName,parallel)
@ -607,14 +611,14 @@ subroutine HDF5_read_real2(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real2: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real2: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real2
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 2 dimensions
!> @brief read dataset of type real with 2 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real3(loc_id,dataset,datasetName,parallel)
@ -647,14 +651,14 @@ subroutine HDF5_read_real3(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real3: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real3: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real3
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 4 dimensions
!> @brief read dataset of type real with 4 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real4(loc_id,dataset,datasetName,parallel)
@ -687,14 +691,14 @@ subroutine HDF5_read_real4(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real4: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real4: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real4
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 5 dimensions
!> @brief read dataset of type real with 5 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real5(loc_id,dataset,datasetName,parallel)
@ -727,14 +731,14 @@ subroutine HDF5_read_real5(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real5: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real5: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real5
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 6 dimensions
!> @brief read dataset of type real with 6 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real6(loc_id,dataset,datasetName,parallel)
@ -767,14 +771,14 @@ subroutine HDF5_read_real6(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real6: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real6: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real6
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 7 dimensions
!> @brief read dataset of type real with 7 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real7(loc_id,dataset,datasetName,parallel)
@ -807,7 +811,7 @@ subroutine HDF5_read_real7(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real7: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real7: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
@ -815,7 +819,7 @@ end subroutine HDF5_read_real7
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pInt with 1 dimension
!> @brief read dataset of type integer with 1 dimension
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_int1(loc_id,dataset,datasetName,parallel)
@ -848,14 +852,14 @@ subroutine HDF5_read_int1(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int1: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int1: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int1
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pInt with 2 dimensions
!> @brief read dataset of type integer with 2 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_int2(loc_id,dataset,datasetName,parallel)
@ -888,14 +892,14 @@ subroutine HDF5_read_int2(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int2: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int2: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int2
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pInt with 3 dimensions
!> @brief read dataset of type integer with 3 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_int3(loc_id,dataset,datasetName,parallel)
@ -928,14 +932,14 @@ subroutine HDF5_read_int3(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int3: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int3: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int3
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pInt withh 4 dimensions
!> @brief read dataset of type integer withh 4 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_int4(loc_id,dataset,datasetName,parallel)
@ -968,14 +972,14 @@ subroutine HDF5_read_int4(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int4: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int4: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int4
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pInt with 5 dimensions
!> @brief read dataset of type integer with 5 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_int5(loc_id,dataset,datasetName,parallel)
@ -1008,14 +1012,14 @@ subroutine HDF5_read_int5(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int5: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int5: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int5
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pInt with 6 dimensions
!> @brief read dataset of type integer with 6 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_int6(loc_id,dataset,datasetName,parallel)
@ -1048,14 +1052,14 @@ subroutine HDF5_read_int6(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int6: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int6: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int6
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pInt with 7 dimensions
!> @brief read dataset of type integer with 7 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_int7(loc_id,dataset,datasetName,parallel)
@ -1088,7 +1092,7 @@ subroutine HDF5_read_int7(loc_id,dataset,datasetName,parallel)
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int7: h5dread_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int7: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
@ -1096,7 +1100,7 @@ end subroutine HDF5_read_int7
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pReal with 1 dimension
!> @brief write dataset of type real with 1 dimension
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel)
@ -1129,7 +1133,7 @@ subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real1: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real1: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1137,7 +1141,7 @@ subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_real1
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pReal with 2 dimensions
!> @brief write dataset of type real with 2 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel)
@ -1170,7 +1174,7 @@ subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real2: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real2: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1178,7 +1182,7 @@ subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_real2
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pReal with 3 dimensions
!> @brief write dataset of type real with 3 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel)
@ -1211,7 +1215,7 @@ subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real3: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real3: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1219,7 +1223,7 @@ subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_real3
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pReal with 4 dimensions
!> @brief write dataset of type real with 4 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel)
@ -1252,7 +1256,7 @@ subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real4: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real4: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1261,7 +1265,7 @@ end subroutine HDF5_write_real4
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pReal with 5 dimensions
!> @brief write dataset of type real with 5 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel)
@ -1294,7 +1298,7 @@ subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real5: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real5: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1302,7 +1306,7 @@ subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_real5
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pReal with 6 dimensions
!> @brief write dataset of type real with 6 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel)
@ -1335,7 +1339,7 @@ subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real6: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real6: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1343,7 +1347,7 @@ subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_real6
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pReal with 7 dimensions
!> @brief write dataset of type real with 7 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel)
@ -1376,7 +1380,7 @@ subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real7: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real7: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1385,7 +1389,7 @@ end subroutine HDF5_write_real7
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pInt with 1 dimension
!> @brief write dataset of type integer with 1 dimension
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel)
@ -1418,7 +1422,7 @@ subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int1: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int1: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1426,7 +1430,7 @@ subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_int1
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pInt with 2 dimensions
!> @brief write dataset of type integer with 2 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel)
@ -1459,7 +1463,7 @@ subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int2: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int2: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1467,7 +1471,7 @@ subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_int2
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pInt with 3 dimensions
!> @brief write dataset of type integer with 3 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel)
@ -1500,7 +1504,7 @@ subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int3: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int3: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1508,7 +1512,7 @@ subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_int3
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pInt with 4 dimensions
!> @brief write dataset of type integer with 4 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel)
@ -1541,7 +1545,7 @@ subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int4: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int4: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1549,7 +1553,7 @@ subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_int4
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pInt with 5 dimensions
!> @brief write dataset of type integer with 5 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel)
@ -1582,7 +1586,7 @@ subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int5: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int5: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1590,7 +1594,7 @@ subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_int5
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pInt with 6 dimensions
!> @brief write dataset of type integer with 6 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel)
@ -1623,7 +1627,7 @@ subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int6: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int6: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1631,7 +1635,7 @@ subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel)
end subroutine HDF5_write_int6
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type pInt with 7 dimensions
!> @brief write dataset of type integer with 7 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel)
@ -1664,7 +1668,7 @@ subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel)
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int7: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int7: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1740,7 +1744,7 @@ subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel)
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
call h5dwrite_f(dset_id, z_id,dataset_asArray(4,:),int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_rotation: h5dwrite_f')
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_rotation: h5dwrite_f')
endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1765,7 +1769,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
globalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(pInt), dimension(worldsize) :: &
integer, dimension(worldsize) :: &
readSize !< contribution of all processes
integer :: ierr
integer :: hdferr
@ -1773,17 +1777,17 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
!-------------------------------------------------------------------------------------------------
! creating a property list for transfer properties (is collective for MPI)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f')
!--------------------------------------------------------------------------------------------------
readSize = 0_pInt
readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt)
readSize = 0
readSize(worldrank+1) = int(localShape(ubound(localShape,1)))
#ifdef PETSc
if (parallel) then
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_dxpl_mpio_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_dxpl_mpio_f')
call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_read: MPI_allreduce')
if (ierr /= 0) call IO_error(894,ext_msg='initialize_read: MPI_allreduce')
endif
#endif
myStart = int(0,HSIZE_T)
@ -1793,28 +1797,28 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
!--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape)
call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5screate_simple_f/memspace_id')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5screate_simple_f/memspace_id')
!--------------------------------------------------------------------------------------------------
! creating a property list for IO and set it to collective
call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f')
#ifdef PETSc
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f')
#endif
!--------------------------------------------------------------------------------------------------
! open the dataset in the file and get the space ID
call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dopen_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dopen_f')
call h5dget_space_f(dset_id, filespace_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dget_space_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dget_space_f')
!--------------------------------------------------------------------------------------------------
! select a hyperslab (the portion of the current process) in the file
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5sselect_hyperslab_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5sselect_hyperslab_f')
end subroutine initialize_read
@ -1828,15 +1832,15 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer :: hdferr
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: plist_id')
call h5pclose_f(aplist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: aplist_id')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: aplist_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5dclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5dclose_f')
call h5sclose_f(filespace_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/filespace_id')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/filespace_id')
call h5sclose_f(memspace_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/memspace_id')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/memspace_id')
end subroutine finalize_read
@ -1867,22 +1871,22 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
!-------------------------------------------------------------------------------------------------
! creating a property list for transfer properties (is collective when reading in parallel)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pcreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pcreate_f')
#ifdef PETSc
if (parallel) then
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pset_dxpl_mpio_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pset_dxpl_mpio_f')
endif
#endif
!--------------------------------------------------------------------------------------------------
! determine the global data layout among all processes
writeSize = 0_pInt
writeSize(worldrank+1) = int(myShape(ubound(myShape,1)),pInt)
writeSize = 0
writeSize(worldrank+1) = int(myShape(ubound(myShape,1)))
#ifdef PETSc
if (parallel) then
call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_write: MPI_allreduce')
if (ierr /= 0) call IO_error(894,ext_msg='initialize_write: MPI_allreduce')
endif
#endif
myStart = int(0,HSIZE_T)
@ -1892,17 +1896,16 @@ if (parallel) then
!--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape) and in file (global shape)
call h5screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dopen_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dopen_f')
call h5screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dget_space_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dget_space_f')
!--------------------------------------------------------------------------------------------------
! create dataset in the file and select a hyperslab from it (the portion of the current process)
call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dcreate_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dcreate_f')
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5sselect_hyperslab_f')
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5sselect_hyperslab_f')
end subroutine initialize_write
@ -1916,14 +1919,15 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id)
integer :: hdferr
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: plist_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5dclose_f')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5dclose_f')
call h5sclose_f(filespace_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/filespace_id')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/filespace_id')
call h5sclose_f(memspace_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/memspace_id')
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/memspace_id')
end subroutine finalize_write
#endif
end module HDF5_Utilities

12
src/IO.f90
View File

@ -356,7 +356,7 @@ logical pure function IO_isBlank(string)
character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: comment = achar(35) ! comment id '#'
integer :: posNonBlank, posComment ! no pInt
integer :: posNonBlank, posComment
posNonBlank = verify(string,blankChar)
posComment = scan(string,comment)
@ -377,7 +377,7 @@ pure function IO_getTag(string,openChar,closeChar)
closeChar !< indicates end of tag
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right ! no pInt
integer :: left,right
IO_getTag = ''
@ -408,7 +408,7 @@ pure function IO_stringPos(string)
character(len=*), intent(in) :: string !< string in which chunk positions 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)
integer :: left, right
allocate(IO_stringPos(1), source=0)
right = 0
@ -417,7 +417,7 @@ pure function IO_stringPos(string)
left = right + verify(string(right+1:),SEP)
right = left + scan(string(left:),SEP) - 2
if ( string(left:left) == '#' ) exit
IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)]
IO_stringPos = [IO_stringPos,left, right]
IO_stringPos(1) = IO_stringPos(1)+1
endOfString: if (right < left) then
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string)
@ -568,7 +568,7 @@ pure function IO_lc(string)
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n ! no pInt (len returns default integer)
integer :: i,n
IO_lc = string
do i=1,len(string)
@ -590,7 +590,7 @@ pure function IO_intOut(intToPrint)
character(len=19) :: width ! maximum digits for 64 bit integer
character(len=20) :: min_width ! longer for negative values
N_digits = 1 + int(log10(real(max(abs(intToPrint),1))),pInt)
N_digits = 1 + int(log10(real(max(abs(intToPrint),1))))
write(width, '(I19.19)') N_digits
write(min_width, '(I20.20)') N_digits + merge(1,0,intToPrint < 0)
IO_intOut = 'I'//trim(min_width)//'.'//trim(width)

4
src/MarcInclude/concom2018
View File

@ -5,7 +5,7 @@
!
! MSC.Marc include file
!
integer(pInt) &
integer &
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
@ -27,7 +27,7 @@ integer(pInt) &
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg
dimension :: ideva(60)
integer(pInt) num_concom
integer num_concom
parameter(num_concom=251)
common/marc_concom/&
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&

4
src/MarcInclude/concom2018.1
View File

@ -5,7 +5,7 @@
!
! MSC.Marc include file
!
integer(pInt) &
integer &
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
@ -27,7 +27,7 @@ integer(pInt) &
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg
dimension :: ideva(60)
integer(pInt) num_concom
integer num_concom
parameter(num_concom=251)
common/marc_concom/&
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&

4
src/MarcInclude/creeps2018
View File

@ -6,12 +6,12 @@
! MSC.Marc include file
!
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b
integer(pInt) icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
integer icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
real(pReal) fraction_donn,timinc_ol2
!
integer(pInt) num_creepsr,num_creepsi,num_creeps2r
integer num_creepsr,num_creepsi,num_creeps2r
parameter(num_creepsr=7)
parameter(num_creepsi=17)
parameter(num_creeps2r=6)

4
src/MarcInclude/creeps2018.1
View File

@ -6,12 +6,12 @@
! MSC.Marc include file
!
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b
integer(pInt) icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
integer icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
real(pReal) fraction_donn,timinc_ol2
!
integer(pInt) num_creepsr,num_creepsi,num_creeps2r
integer num_creepsr,num_creepsi,num_creeps2r
parameter(num_creepsr=7)
parameter(num_creepsi=17)
parameter(num_creeps2r=6)

7
src/commercialFEM_fileList.f90
View File

@ -17,16 +17,15 @@
#include "geometry_plastic_nonlocal.f90"
#include "element.f90"
#include "mesh_base.f90"
#include "HDF5_utilities.f90"
#include "results.f90"
#include "discretization.f90"
#ifdef Abaqus
#include "mesh_abaqus.f90"
#endif
#ifdef Marc4DAMASK
#include "mesh_marc.f90"
#endif
#ifdef DAMASK_HDF5
#include "HDF5_utilities.f90"
#include "results.f90"
#endif
#include "material.f90"
#include "lattice.f90"
#include "source_thermal_dissipation.f90"

348
src/constitutive.f90
View File

@ -5,9 +5,37 @@
!--------------------------------------------------------------------------------------------------
module constitutive
use math
use debug
use numerics
use IO
use config
use material
use results
use HDF5_utilities
use lattice
use mesh
use discretization
use plastic_none
use plastic_isotropic
use plastic_phenopowerlaw
use plastic_kinehardening
use plastic_dislotwin
use plastic_disloucla
use plastic_nonlocal
use geometry_plastic_nonlocal
use source_thermal_dissipation
use source_thermal_externalheat
use source_damage_isoBrittle
use source_damage_isoDuctile
use source_damage_anisoBrittle
use source_damage_anisoDuctile
use kinematics_cleavage_opening
use kinematics_slipplane_opening
use kinematics_thermal_expansion
implicit none
private
integer, public, protected :: &
constitutive_plasticity_maxSizePostResults, &
constitutive_plasticity_maxSizeDotState, &
@ -37,74 +65,6 @@ contains
!> @brief allocates arrays pointing to array of the various constitutive modules
!--------------------------------------------------------------------------------------------------
subroutine constitutive_init
use debug, only: &
debug_constitutive, &
debug_levelBasic
use numerics, only: &
worldrank
use IO, only: &
IO_error, &
IO_write_jobFile
use config, only: &
material_Nphase, &
phase_name
use material, only: &
material_phase, &
phase_plasticity, &
phase_plasticityInstance, &
phase_Nsources, &
phase_source, &
phase_kinematics, &
ELASTICITY_hooke_ID, &
PLASTICITY_none_ID, &
PLASTICITY_isotropic_ID, &
PLASTICITY_phenopowerlaw_ID, &
PLASTICITY_kinehardening_ID, &
PLASTICITY_dislotwin_ID, &
PLASTICITY_disloucla_ID, &
PLASTICITY_nonlocal_ID ,&
SOURCE_thermal_dissipation_ID, &
SOURCE_thermal_externalheat_ID, &
SOURCE_damage_isoBrittle_ID, &
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_thermal_expansion_ID, &
ELASTICITY_HOOKE_label, &
PLASTICITY_NONE_label, &
PLASTICITY_ISOTROPIC_label, &
PLASTICITY_PHENOPOWERLAW_label, &
PLASTICITY_KINEHARDENING_label, &
PLASTICITY_DISLOTWIN_label, &
PLASTICITY_DISLOUCLA_label, &
PLASTICITY_NONLOCAL_label, &
SOURCE_thermal_dissipation_label, &
SOURCE_thermal_externalheat_label, &
SOURCE_damage_isoBrittle_label, &
SOURCE_damage_isoDuctile_label, &
SOURCE_damage_anisoBrittle_label, &
SOURCE_damage_anisoDuctile_label, &
plasticState, &
sourceState
use plastic_none
use plastic_isotropic
use plastic_phenopowerlaw
use plastic_kinehardening
use plastic_dislotwin
use plastic_disloucla
use plastic_nonlocal
use source_thermal_dissipation
use source_thermal_externalheat
use source_damage_isoBrittle
use source_damage_isoDuctile
use source_damage_anisoBrittle
use source_damage_anisoDuctile
use kinematics_cleavage_opening
use kinematics_slipplane_opening
use kinematics_thermal_expansion
integer, parameter :: FILEUNIT = 204
integer :: &
@ -127,8 +87,11 @@ subroutine constitutive_init
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init
if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init
if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init
if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) call plastic_nonlocal_init
if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then
call plastic_nonlocal_init
else
call geometry_plastic_nonlocal_disable
endif
!--------------------------------------------------------------------------------------------------
! initialize source mechanisms
if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init
@ -281,15 +244,6 @@ end subroutine constitutive_init
!> ToDo: homogenizedC66 would be more consistent
!--------------------------------------------------------------------------------------------------
function constitutive_homogenizedC(ipc,ip,el)
use material, only: &
phase_plasticity, &
material_phase, &
PLASTICITY_DISLOTWIN_ID, &
PLASTICITY_DISLOUCLA_ID
use plastic_dislotwin, only: &
plastic_dislotwin_homogenizedC
use lattice, only: &
lattice_C66
real(pReal), dimension(6,6) :: constitutive_homogenizedC
integer, intent(in) :: &
@ -310,23 +264,6 @@ end function constitutive_homogenizedC
!> @brief calls microstructure function of the different constitutive models
!--------------------------------------------------------------------------------------------------
subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el)
use material, only: &
phasememberAt, &
phase_plasticity, &
phase_plasticityInstance, &
material_phase, &
material_homogenizationAt, &
temperature, &
thermalMapping, &
PLASTICITY_dislotwin_ID, &
PLASTICITY_disloucla_ID, &
PLASTICITY_nonlocal_ID
use plastic_nonlocal, only: &
plastic_nonlocal_dependentState
use plastic_dislotwin, only: &
plastic_dislotwin_dependentState
use plastic_disloUCLA, only: &
plastic_disloUCLA_dependentState
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -366,35 +303,6 @@ end subroutine constitutive_microstructure
!--------------------------------------------------------------------------------------------------
subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
S, Fi, ipc, ip, el)
use material, only: &
phasememberAt, &
phase_plasticity, &
phase_plasticityInstance, &
material_phase, &
material_homogenizationAt, &
temperature, &
thermalMapping, &
PLASTICITY_NONE_ID, &
PLASTICITY_ISOTROPIC_ID, &
PLASTICITY_PHENOPOWERLAW_ID, &
PLASTICITY_KINEHARDENING_ID, &
PLASTICITY_DISLOTWIN_ID, &
PLASTICITY_DISLOUCLA_ID, &
PLASTICITY_NONLOCAL_ID
use mesh, only: &
mesh_ipVolume
use plastic_isotropic, only: &
plastic_isotropic_LpAndItsTangent
use plastic_phenopowerlaw, only: &
plastic_phenopowerlaw_LpAndItsTangent
use plastic_kinehardening, only: &
plastic_kinehardening_LpAndItsTangent
use plastic_dislotwin, only: &
plastic_dislotwin_LpAndItsTangent
use plastic_disloucla, only: &
plastic_disloucla_LpAndItsTangent
use plastic_nonlocal, only: &
plastic_nonlocal_LpAndItsTangent
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -446,7 +354,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
case (PLASTICITY_NONLOCAL_ID) plasticityType
call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, &
temperature(ho)%p(tme),mesh_ipVolume(ip,el),ip,el)
temperature(ho)%p(tme),geometry_plastic_nonlocal_IPvolume0(ip,el),ip,el)
case (PLASTICITY_DISLOTWIN_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -475,26 +383,6 @@ end subroutine constitutive_LpAndItsTangents
!--------------------------------------------------------------------------------------------------
subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
S, Fi, ipc, ip, el)
use material, only: &
phasememberAt, &
phase_plasticity, &
phase_plasticityInstance, &
phase_plasticity, &
material_phase, &
phase_kinematics, &
phase_Nkinematics, &
PLASTICITY_isotropic_ID, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_thermal_expansion_ID
use plastic_isotropic, only: &
plastic_isotropic_LiAndItsTangent
use kinematics_cleavage_opening, only: &
kinematics_cleavage_opening_LiAndItsTangent
use kinematics_slipplane_opening, only: &
kinematics_slipplane_opening_LiAndItsTangent
use kinematics_thermal_expansion, only: &
kinematics_thermal_expansion_LiAndItsTangent
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -573,16 +461,6 @@ end subroutine constitutive_LiAndItsTangents
!> @brief collects initial intermediate deformation gradient
!--------------------------------------------------------------------------------------------------
pure function constitutive_initialFi(ipc, ip, el)
use material, only: &
material_phase, &
material_homogenizationAt, &
thermalMapping, &
phase_kinematics, &
phase_Nkinematics, &
material_phase, &
KINEMATICS_thermal_expansion_ID
use kinematics_thermal_expansion, only: &
kinematics_thermal_expansion_initialStrain
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -644,14 +522,6 @@ end subroutine constitutive_SandItsTangents
!--------------------------------------------------------------------------------------------------
subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
Fe, Fi, ipc, ip, el)
use material, only: &
material_phase, &
material_homogenizationAt, &
phase_NstiffnessDegradations, &
phase_stiffnessDegradation, &
damage, &
damageMapping, &
STIFFNESS_DEGRADATION_damage_ID
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -700,54 +570,6 @@ end subroutine constitutive_hooke_SandItsTangents
!> @brief contains the constitutive equation for calculating the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, el)
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic
use mesh, only: &
theMesh
use material, only: &
phasememberAt, &
phase_plasticityInstance, &
phase_plasticity, &
phase_source, &
phase_Nsources, &
material_phase, &
material_homogenizationAt, &
temperature, &
thermalMapping, &
homogenization_maxNgrains, &
PLASTICITY_none_ID, &
PLASTICITY_isotropic_ID, &
PLASTICITY_phenopowerlaw_ID, &
PLASTICITY_kinehardening_ID, &
PLASTICITY_dislotwin_ID, &
PLASTICITY_disloucla_ID, &
PLASTICITY_nonlocal_ID, &
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID, &
SOURCE_thermal_externalheat_ID
use plastic_isotropic, only: &
plastic_isotropic_dotState
use plastic_phenopowerlaw, only: &
plastic_phenopowerlaw_dotState
use plastic_kinehardening, only: &
plastic_kinehardening_dotState
use plastic_dislotwin, only: &
plastic_dislotwin_dotState
use plastic_disloucla, only: &
plastic_disloucla_dotState
use plastic_nonlocal, only: &
plastic_nonlocal_dotState
use source_damage_isoDuctile, only: &
source_damage_isoDuctile_dotState
use source_damage_anisoBrittle, only: &
source_damage_anisoBrittle_dotState
use source_damage_anisoDuctile, only: &
source_damage_anisoDuctile_dotState
use source_thermal_externalheat, only: &
source_thermal_externalheat_dotState
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -755,7 +577,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip,
el !< element
real(pReal), intent(in) :: &
subdt !< timestep
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
FeArray, & !< elastic deformation gradient
FpArray !< plastic deformation gradient
real(pReal), intent(in), dimension(3,3) :: &
@ -835,26 +657,6 @@ end subroutine constitutive_collectDotState
!> will return false if delta state is not needed/supported by the constitutive model
!--------------------------------------------------------------------------------------------------
subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el)
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic
use material, only: &
phasememberAt, &
phase_plasticityInstance, &
phase_plasticity, &
phase_source, &
phase_Nsources, &
material_phase, &
PLASTICITY_KINEHARDENING_ID, &
PLASTICITY_NONLOCAL_ID, &
SOURCE_damage_isoBrittle_ID
use plastic_kinehardening, only: &
plastic_kinehardening_deltaState
use plastic_nonlocal, only: &
plastic_nonlocal_deltaState
use source_damage_isoBrittle, only: &
source_damage_isoBrittle_deltaState
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -903,49 +705,6 @@ end subroutine constitutive_collectDeltaState
!> @brief returns array of constitutive results
!--------------------------------------------------------------------------------------------------
function constitutive_postResults(S, Fi, ipc, ip, el)
use material, only: &
phasememberAt, &
phase_plasticityInstance, &
plasticState, &
sourceState, &
phase_plasticity, &
phase_source, &
phase_Nsources, &
material_phase, &
material_homogenizationAt, &
temperature, &
thermalMapping, &
PLASTICITY_NONE_ID, &
PLASTICITY_ISOTROPIC_ID, &
PLASTICITY_PHENOPOWERLAW_ID, &
PLASTICITY_KINEHARDENING_ID, &
PLASTICITY_DISLOTWIN_ID, &
PLASTICITY_DISLOUCLA_ID, &
PLASTICITY_NONLOCAL_ID, &
SOURCE_damage_isoBrittle_ID, &
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID
use plastic_isotropic, only: &
plastic_isotropic_postResults
use plastic_phenopowerlaw, only: &
plastic_phenopowerlaw_postResults
use plastic_kinehardening, only: &
plastic_kinehardening_postResults
use plastic_dislotwin, only: &
plastic_dislotwin_postResults
use plastic_disloucla, only: &
plastic_disloucla_postResults
use plastic_nonlocal, only: &
plastic_nonlocal_postResults
use source_damage_isoBrittle, only: &
source_damage_isoBrittle_postResults
use source_damage_isoDuctile, only: &
source_damage_isoDuctile_postResults
use source_damage_anisoBrittle, only: &
source_damage_anisoBrittle_postResults
use source_damage_anisoDuctile, only: &
source_damage_anisoDuctile_postResults
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -1031,47 +790,18 @@ end function constitutive_postResults
!> @brief writes constitutive results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine constitutive_results
use material, only: &
PLASTICITY_ISOTROPIC_ID, &
PLASTICITY_PHENOPOWERLAW_ID, &
PLASTICITY_KINEHARDENING_ID, &
PLASTICITY_DISLOTWIN_ID, &
PLASTICITY_DISLOUCLA_ID, &
PLASTICITY_NONLOCAL_ID
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
use HDF5_utilities
use config, only: &
config_name_phase => phase_name ! anticipate logical name
use material, only: &
phase_plasticityInstance, &
material_phase_plasticity_type => phase_plasticity
use plastic_isotropic, only: &
plastic_isotropic_results
use plastic_phenopowerlaw, only: &
plastic_phenopowerlaw_results
use plastic_kinehardening, only: &
plastic_kinehardening_results
use plastic_dislotwin, only: &
plastic_dislotwin_results
use plastic_disloUCLA, only: &
plastic_disloUCLA_results
use plastic_nonlocal, only: &
plastic_nonlocal_results
integer :: p
character(len=256) :: group
do p=1,size(config_name_phase)
group = trim('current/constituent')//'/'//trim(config_name_phase(p))
#if defined(PETSc) || defined(DAMASK_HDF5)
do p=1,size(phase_name)
group = trim('current/constituent')//'/'//trim(phase_name(p))
call HDF5_closeGroup(results_addGroup(group))
group = trim(group)//'/plastic'
call HDF5_closeGroup(results_addGroup(group))
select case(material_phase_plasticity_type(p))
select case(phase_plasticity(p))
case(PLASTICITY_ISOTROPIC_ID)
call plastic_isotropic_results(phase_plasticityInstance(p),group)

100
src/crystallite.f90
View File

@ -20,13 +20,15 @@ module crystallite
use FEsolving
use material
use constitutive
use discretization
use lattice
use future
use plastic_nonlocal
#if defined(PETSc) || defined(DAMASK_HDF5)
use geometry_plastic_nonlocal, only: &
nIPneighbors => geometry_plastic_nonlocal_nIPneighbors, &
IPneighborhood => geometry_plastic_nonlocal_IPneighborhood
use HDF5_utilities
use results
#endif
implicit none
private
@ -172,8 +174,8 @@ subroutine crystallite_init
write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
cMax = homogenization_maxNgrains
iMax = theMesh%elem%nIPs
eMax = theMesh%nElems
iMax = discretization_nIP
eMax = discretization_nElem
allocate(crystallite_S0(3,3,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_partionedS0(3,3,cMax,iMax,eMax), source=0.0_pReal)
@ -342,7 +344,7 @@ subroutine crystallite_init
case(elasmatrix_ID)
mySize = 36
case(neighboringip_ID,neighboringelement_ID)
mySize = theMesh%elem%nIPneighbors
mySize = nIPneighbors
case default
mySize = 0
end select
@ -361,7 +363,7 @@ subroutine crystallite_init
call IO_write_jobFile(FILEUNIT,'outputCrystallite')
do r = 1,size(config_crystallite)
if (any(microstructure_crystallite(mesh_element(4,:)) == r)) then
if (any(microstructure_crystallite(discretization_microstructureAt) == r)) then
write(FILEUNIT,'(/,a,/)') '['//trim(crystallite_name(r))//']'
do o = 1,crystallite_Noutput(r)
write(FILEUNIT,'(a,i4)') trim(crystallite_output(o,r))//char(9),crystallite_sizePostResult(o,r)
@ -379,7 +381,7 @@ subroutine crystallite_init
! initialize
!$OMP PARALLEL DO PRIVATE(myNcomponents,i,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
myNcomponents = homogenization_Ngrains(material_homogenizationAt(e))
do i = FEsolving_execIP(1,e), FEsolving_execIP(2,e); do c = 1, myNcomponents
crystallite_Fp0(1:3,1:3,c,i,e) = math_EulerToR(material_EulerAngles(1:3,c,i,e)) ! plastic def gradient reflects init orientation
crystallite_Fi0(1:3,1:3,c,i,e) = constitutive_initialFi(c,i,e)
@ -407,7 +409,7 @@ subroutine crystallite_init
!$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do c = 1,homogenization_Ngrains(mesh_element(3,e))
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
call constitutive_microstructure(crystallite_Fe(1:3,1:3,c,i,e), &
crystallite_Fp(1:3,1:3,c,i,e), &
c,i,e) ! update dependent state variables to be consistent with basic states
@ -424,7 +426,6 @@ subroutine crystallite_init
write(6,'(a42,1x,i10)') ' # of elements: ', eMax
write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax
write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax
write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', theMesh%elem%nIPneighbors
write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity)
flush(6)
endif
@ -441,7 +442,7 @@ end subroutine crystallite_init
!--------------------------------------------------------------------------------------------------
function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress
logical, dimension(discretization_nIP,discretization_nElem) :: crystallite_stress
real(pReal), intent(in), optional :: &
dummyArgumentToPreventInternalCompilerErrorWithGCC
real(pReal) :: &
@ -480,7 +481,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
crystallite_subStep = 0.0_pReal
!$OMP PARALLEL DO
elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then
plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = &
plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e))
@ -510,7 +511,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
endIP = startIP
else singleRun
startIP = 1
endIP = theMesh%elem%nIPs
endIP = discretization_nIP
endif singleRun
NiterationCrystallite = 0
@ -524,7 +525,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
!$OMP PARALLEL DO PRIVATE(formerSubStep)
elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do c = 1,homogenization_Ngrains(mesh_element(3,e))
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
!--------------------------------------------------------------------------------------------------
! wind forward
if (crystallite_converged(c,i,e)) then
@ -646,7 +647,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
#ifdef DEBUG
elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do c = 1,homogenization_Ngrains(mesh_element(3,e))
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (.not. crystallite_converged(c,i,e)) then
if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) &
write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST stress >> no convergence at el ip ipc ', &
@ -708,7 +709,7 @@ subroutine crystallite_stressTangent
!$OMP rhs_3333,lhs_3333,temp_99,temp_33_1,temp_33_2,temp_33_3,temp_33_4,temp_3333,error)
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do c = 1,homogenization_Ngrains(mesh_element(3,e))
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
call constitutive_SandItsTangents(devNull,dSdFe,dSdFi, &
crystallite_Fe(1:3,1:3,c,i,e), &
@ -829,7 +830,7 @@ subroutine crystallite_orientations
!$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do c = 1,homogenization_Ngrains(mesh_element(3,e))
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
call crystallite_orientation(c,i,e)%fromRotationMatrix(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e))))
enddo; enddo; enddo
!$OMP END PARALLEL DO
@ -851,11 +852,6 @@ end subroutine crystallite_orientations
!> @brief Map 2nd order tensor to reference config
!--------------------------------------------------------------------------------------------------
function crystallite_push33ToRef(ipc,ip,el, tensor33)
use math, only: &
math_inv33, &
math_EulerToR
use material, only: &
material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0
real(pReal), dimension(3,3) :: crystallite_push33ToRef
real(pReal), dimension(3,3), intent(in) :: tensor33
@ -882,12 +878,10 @@ function crystallite_postResults(ipc, ip, el)
ip, & !< integration point index
ipc !< grain index
real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(mesh_element(4,el))) + &
real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(discretization_microstructureAt(el))) + &
1+plasticState(material_phase(ipc,ip,el))%sizePostResults + &
sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: &
crystallite_postResults
real(pReal) :: &
detF
integer :: &
o, &
c, &
@ -896,7 +890,7 @@ function crystallite_postResults(ipc, ip, el)
n
type(rotation) :: rot
crystID = microstructure_crystallite(mesh_element(4,el))
crystID = microstructure_crystallite(discretization_microstructureAt(el))
crystallite_postResults = 0.0_pReal
crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length)
@ -960,15 +954,15 @@ function crystallite_postResults(ipc, ip, el)
mySize = 36
crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize])
case(neighboringelement_ID)
mySize = theMesh%elem%nIPneighbors
mySize = nIPneighbors
crystallite_postResults(c+1:c+mySize) = 0.0_pReal
forall (n = 1:mySize) &
crystallite_postResults(c+n) = real(mesh_ipNeighborhood(1,n,ip,el),pReal)
crystallite_postResults(c+n) = real(IPneighborhood(1,n,ip,el),pReal)
case(neighboringip_ID)
mySize = theMesh%elem%nIPneighbors
mySize = nIPneighbors
crystallite_postResults(c+1:c+mySize) = 0.0_pReal
forall (n = 1:mySize) &
crystallite_postResults(c+n) = real(mesh_ipNeighborhood(2,n,ip,el),pReal)
crystallite_postResults(c+n) = real(IPneighborhood(2,n,ip,el),pReal)
end select
c = c + mySize
enddo
@ -1064,10 +1058,6 @@ subroutine crystallite_results
!--------------------------------------------------------------------------------------------------
function select_tensors(dataset,instance)
use material, only: &
homogenization_maxNgrains, &
material_phaseAt
integer, intent(in) :: instance
real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset
real(pReal), allocatable, dimension(:,:,:) :: select_tensors
@ -1095,10 +1085,6 @@ subroutine crystallite_results
!--------------------------------------------------------------------------------------------------
function select_rotations(dataset,instance)
use material, only: &
homogenization_maxNgrains, &
material_phaseAt
integer, intent(in) :: instance
type(rotation), dimension(:,:,:), intent(in) :: dataset
type(rotation), allocatable, dimension(:) :: select_rotations
@ -1567,7 +1553,7 @@ subroutine integrateStateFPI
!$OMP PARALLEL DO PRIVATE(p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
@ -1595,7 +1581,7 @@ subroutine integrateStateFPI
!$OMP DO PRIVATE(sizeDotState,residuum_plastic,residuum_source,zeta,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
sizeDotState = plasticState(p)%sizeDotState
@ -1650,7 +1636,7 @@ subroutine integrateStateFPI
!$OMP DO
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
!$OMP FLUSH(crystallite_todo)
if (crystallite_todo(g,i,e) .and. crystallite_converged(g,i,e)) then ! converged and still alive...
crystallite_todo(g,i,e) = stateJump(g,i,e)
@ -1676,7 +1662,7 @@ subroutine integrateStateFPI
doneWithIntegration = .true.
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
doneWithIntegration = .false.
exit
@ -1744,11 +1730,11 @@ subroutine integrateStateAdaptiveEuler
! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler
real(pReal), dimension(constitutive_plasticity_maxSizeDotState, &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
residuum_plastic
real(pReal), dimension(constitutive_source_maxSizeDotState,&
maxval(phase_Nsources), &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
residuum_source
!--------------------------------------------------------------------------------------------------
@ -1758,7 +1744,7 @@ subroutine integrateStateAdaptiveEuler
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
sizeDotState = plasticState(p)%sizeDotState
@ -1787,7 +1773,7 @@ subroutine integrateStateAdaptiveEuler
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
sizeDotState = plasticState(p)%sizeDotState
@ -1847,7 +1833,7 @@ subroutine integrateStateRK4
!$OMP PARALLEL DO PRIVATE(p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
@ -1919,11 +1905,11 @@ subroutine integrateStateRKCK45
! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45
real(pReal), dimension(constitutive_plasticity_maxSizeDotState, &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
residuum_plastic ! relative residuum from evolution in microstructure
real(pReal), dimension(constitutive_source_maxSizeDotState, &
maxval(phase_Nsources), &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
residuum_source ! relative residuum from evolution in microstructure
@ -1938,7 +1924,7 @@ subroutine integrateStateRKCK45
!$OMP PARALLEL DO PRIVATE(p,cc)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
@ -1978,7 +1964,7 @@ subroutine integrateStateRKCK45
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
@ -2017,7 +2003,7 @@ subroutine integrateStateRKCK45
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
@ -2075,7 +2061,7 @@ subroutine setConvergenceFlag
!OMP DO PARALLEL PRIVATE
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definition
enddo; enddo; enddo
!OMP END DO PARALLEL
@ -2115,7 +2101,7 @@ subroutine update_stress(timeFraction)
!$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
!$OMP FLUSH(crystallite_todo)
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
crystallite_todo(g,i,e) = integrateStress(g,i,e,timeFraction)
@ -2145,7 +2131,7 @@ subroutine update_dependentState
!$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) &
call constitutive_dependentState(crystallite_Fe(1:3,1:3,g,i,e), &
crystallite_Fp(1:3,1:3,g,i,e), &
@ -2175,7 +2161,7 @@ subroutine update_state(timeFraction)
!$OMP PARALLEL DO PRIVATE(mySize,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
@ -2220,7 +2206,7 @@ subroutine update_dotState(timeFraction)
!$OMP PARALLEL DO PRIVATE (p,c,NaN)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
!$OMP FLUSH(nonlocalStop)
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
call constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), &
@ -2266,7 +2252,7 @@ subroutine update_deltaState
!$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,NaN)
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
!$OMP FLUSH(nonlocalStop)
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
call constitutive_collectDeltaState(crystallite_S(1:3,1:3,g,i,e), &

32
src/damage_local.f90
View File

@ -7,23 +7,27 @@ module damage_local
use material
use numerics
use config
use source_damage_isoBrittle
use source_damage_isoDuctile
use source_damage_anisoBrittle
use source_damage_anisoDuctile
implicit none
private
integer, dimension(:,:), allocatable, target, public :: &
damage_local_sizePostResult !< size of each post result output
damage_local_sizePostResult
character(len=64), dimension(:,:), allocatable, target, public :: &
damage_local_output !< name of each post result output
damage_local_output
integer, dimension(:), allocatable, target, public :: &
damage_local_Noutput !< number of outputs per instance of this damage
damage_local_Noutput
enum, bind(c)
enumerator :: undefined_ID, &
enumerator :: &
undefined_ID, &
damage_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable :: &
damage_local_outputID !< ID of each post result output
@ -40,7 +44,6 @@ module damage_local
damage_local_updateState, &
damage_local_postResults
contains
!--------------------------------------------------------------------------------------------------
@ -116,9 +119,9 @@ subroutine damage_local_init
end associate
enddo
end subroutine damage_local_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates local change in damage field
!--------------------------------------------------------------------------------------------------
@ -153,18 +156,11 @@ function damage_local_updateState(subdt, ip, el)
end function damage_local_updateState
!--------------------------------------------------------------------------------------------------
!> @brief calculates homogenized local damage driving forces
!--------------------------------------------------------------------------------------------------
subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
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
integer, intent(in) :: &
ip, & !< integration point number
@ -225,8 +221,7 @@ function damage_local_postResults(ip,el)
real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
damage_local_postResults
integer :: &
instance, homog, offset, o, c
integer :: instance, homog, offset, o, c
homog = material_homogenizationAt(el)
offset = damageMapping(homog)%p(ip,el)
@ -244,6 +239,7 @@ function damage_local_postResults(ip,el)
enddo outputsLoop
end associate
end function damage_local_postResults
end module damage_local

15
src/damage_nonlocal.f90
View File

@ -20,16 +20,15 @@ module damage_nonlocal
private
integer, dimension(:,:), allocatable, target, public :: &
damage_nonlocal_sizePostResult !< size of each post result output
damage_nonlocal_sizePostResult
character(len=64), dimension(:,:), allocatable, target, public :: &
damage_nonlocal_output !< name of each post result output
damage_nonlocal_output
integer, dimension(:), allocatable, target, public :: &
damage_nonlocal_Noutput !< number of outputs per instance of this damage
damage_nonlocal_Noutput
enum, bind(c)
enumerator :: undefined_ID, &
enumerator :: &
undefined_ID, &
damage_ID
end enum
@ -217,12 +216,12 @@ real(pReal) function damage_nonlocal_getMobility(ip,el)
damage_nonlocal_getMobility = 0.0_pReal
do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
do ipc = 1, homogenization_Ngrains(material_homogenizationAt(el))
damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el))
enddo
damage_nonlocal_getMobility = damage_nonlocal_getMobility/&
real(homogenization_Ngrains(mesh_element(3,el)),pReal)
real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end function damage_nonlocal_getMobility

110
src/debug.f90
View File

@ -12,49 +12,49 @@ module debug
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 :: &
integer, parameter, public :: &
debug_LEVELSELECTIVE = 2**0, &
debug_LEVELBASIC = 2**1, &
debug_LEVELEXTENSIVE = 2**2
integer, 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, parameter, public :: &
debug_SPECTRALRESTART = debug_MAXGENERAL*2**1, &
debug_SPECTRALFFTW = debug_MAXGENERAL*2**2, &
debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2**3, &
debug_SPECTRALROTATION = debug_MAXGENERAL*2**4, &
debug_SPECTRALPETSC = debug_MAXGENERAL*2**5
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 :: &
integer, parameter, public :: &
debug_DEBUG = 1, &
debug_MATH = 2, &
debug_FESOLVING = 3, &
debug_MESH = 4, & !< stores debug level for mesh part of DAMASK bitwise coded
debug_MATERIAL = 5, & !< stores debug level for material part of DAMASK bitwise coded
debug_LATTICE = 6, & !< stores debug level for lattice part of DAMASK bitwise coded
debug_CONSTITUTIVE = 7, & !< stores debug level for constitutive part of DAMASK bitwise coded
debug_CRYSTALLITE = 8, &
debug_HOMOGENIZATION = 9, &
debug_CPFEM = 10, &
debug_SPECTRAL = 11, &
debug_MARC = 12, &
debug_ABAQUS = 13
integer, 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,protected, dimension(debug_maxNtype+2), public :: & ! specific ones, and 2 for "all" and "other"
debug_level = 0
integer(pInt), protected, public :: &
debug_e = 1_pInt, &
debug_i = 1_pInt, &
debug_g = 1_pInt
integer, protected, public :: &
debug_e = 1, &
debug_i = 1, &
debug_g = 1
integer(pInt), dimension(2), public :: &
debug_stressMaxLocation = 0_pInt, &
debug_stressMinLocation = 0_pInt, &
debug_jacobianMaxLocation = 0_pInt, &
debug_jacobianMinLocation = 0_pInt
integer, dimension(2), public :: &
debug_stressMaxLocation = 0, &
debug_stressMinLocation = 0, &
debug_jacobianMaxLocation = 0, &
debug_jacobianMinLocation = 0
real(pReal), public :: &
@ -100,17 +100,17 @@ subroutine debug_init
line = fileContent(j)
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
select case(tag)
case ('element','e','el')
debug_e = IO_intValue(line,chunkPos,2_pInt)
debug_e = IO_intValue(line,chunkPos,2)
case ('integrationpoint','i','ip')
debug_i = IO_intValue(line,chunkPos,2_pInt)
debug_i = IO_intValue(line,chunkPos,2)
case ('grain','g','gr')
debug_g = IO_intValue(line,chunkPos,2_pInt)
debug_g = IO_intValue(line,chunkPos,2)
end select
what = 0_pInt
what = 0
select case(tag)
case ('debug')
what = debug_DEBUG
@ -139,12 +139,12 @@ subroutine debug_init
case ('abaqus')
what = debug_ABAQUS
case ('all')
what = debug_MAXNTYPE + 1_pInt
what = debug_MAXNTYPE + 1
case ('other')
what = debug_MAXNTYPE + 2_pInt
what = debug_MAXNTYPE + 2
end select
if (what /= 0) then
do i = 2_pInt, chunkPos(1)
do i = 2, chunkPos(1)
select case(IO_lc(IO_stringValue(line,chunkPos,i)))
case('basic')
debug_level(what) = ior(debug_level(what), debug_LEVELBASIC)
@ -167,11 +167,11 @@ subroutine debug_init
endif
enddo
do i = 1_pInt, debug_maxNtype
do i = 1, 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 + 2)) ! 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"
debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 1)) ! fill all debug types with levels specified by "all"
enddo
if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) &
@ -184,7 +184,7 @@ subroutine debug_init
!--------------------------------------------------------------------------------------------------
! 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
do i = 1, debug_MAXNTYPE
select case(i)
case (debug_DEBUG)
tag = ' Debug'
@ -241,10 +241,10 @@ end subroutine debug_init
!--------------------------------------------------------------------------------------------------
subroutine debug_reset
debug_stressMaxLocation = 0_pInt
debug_stressMinLocation = 0_pInt
debug_jacobianMaxLocation = 0_pInt
debug_jacobianMinLocation = 0_pInt
debug_stressMaxLocation = 0
debug_stressMinLocation = 0
debug_jacobianMaxLocation = 0
debug_jacobianMinLocation = 0
debug_stressMax = -huge(1.0_pReal)
debug_stressMin = huge(1.0_pReal)
debug_jacobianMax = -huge(1.0_pReal)
@ -260,8 +260,8 @@ subroutine debug_info
!$OMP CRITICAL (write2out)
debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 &
.and. any(debug_stressMinLocation /= 0_pInt) &
.and. any(debug_stressMaxLocation /= 0_pInt) ) then
.and. any(debug_stressMinLocation /= 0) &
.and. any(debug_stressMaxLocation /= 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,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation

82
src/discretization.f90 Normal file
View File

@ -0,0 +1,82 @@
!--------------------------------------------------------------------------------------------------
!> @brief spatial discretization
!--------------------------------------------------------------------------------------------------
module discretization
use prec
use results
implicit none
private
integer, public, protected :: &
discretization_nIP, &
discretization_nElem
integer, public, protected, dimension(:), allocatable :: &
discretization_homogenizationAt, &
discretization_microstructureAt
real(pReal), public, protected, dimension(:,:), allocatable :: &
discretization_IPcoords0, &
discretization_NodeCoords0, &
discretization_IPcoords, &
discretization_NodeCoords
public :: &
discretization_init, &
discretization_results, &
discretization_setIPcoords
contains
subroutine discretization_init(homogenizationAt,microstructureAt,IPcoords0,NodeCoords0)
integer, dimension(:), intent(in) :: &
homogenizationAt, &
microstructureAt
real(pReal), dimension(:,:), intent(in) :: &
IPcoords0, &
NodeCoords0
write(6,'(/,a)') ' <<<+- discretization init -+>>>'
discretization_nElem = size(microstructureAt,1)
discretization_nIP = size(IPcoords0,2)/discretization_nElem
discretization_homogenizationAt = homogenizationAt
discretization_microstructureAt = microstructureAt
discretization_IPcoords0 = IPcoords0
discretization_IPcoords = IPcoords0
discretization_NodeCoords0 = NodeCoords0
discretization_NodeCoords = NodeCoords0
end subroutine discretization_init
subroutine discretization_results
#if defined(PETSc) || defined(DAMASK_HDF5)
real(pReal), dimension(:,:), allocatable :: u
u = discretization_NodeCoords -discretization_NodeCoords0
call results_writeDataset('current',U,'U','nodal displacements','m')
u = discretization_IPcoords -discretization_IPcoords0
call results_writeDataset('current',u,'u','IP displacements','m')
#endif
end subroutine discretization_results
subroutine discretization_setIPcoords(IPcoords)
real(pReal), dimension(:,:), intent(in) :: IPcoords
discretization_IPcoords = IPcoords
end subroutine discretization_setIPcoords
end module discretization

16
src/element.f90
View File

@ -4,6 +4,7 @@
!--------------------------------------------------------------------------------------------------
module element
use prec
use IO
implicit none
private
@ -27,7 +28,7 @@ module element
NnodeAtIP, &
IPneighbor, &
cellFace
real(pReal), dimension(:,:), allocatable :: &
integer, dimension(:,:), allocatable :: &
! center of gravity of the weighted nodes gives the position of the cell node.
! example: face-centered cell node with face nodes 1,2,5,6 to be used in,
! e.g., an 8 node element, would be encoded: 1, 1, 0, 0, 1, 1, 0, 0
@ -129,7 +130,7 @@ module element
6 & ! 3D 8node
] !< number of ip neighbors / cell faces in a specific cell type
!integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = &
!integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & ! Intel 16.0 complains
integer, dimension(4), parameter, private :: NCELLNODEPERCELLFACE = &
[ &
2, & ! 2D 3node
@ -162,6 +163,10 @@ module element
8 & ! 3D 8node
] !< number of cell nodes in a specific cell type
! --------------------------------------------------------------------------------------------------
! MD: probably not needed START
integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = &
reshape([&
1,2,3 &
@ -266,7 +271,6 @@ module element
7,0, 0,0 &
],[maxNnodeAtIP(10),nIP(10)])
! *** FE_ipNeighbor ***
! is a list of the neighborhood of each IP.
! It is sorted in (local) +x,-x, +y,-y, +z,-z direction.
@ -377,6 +381,10 @@ module element
-3,26,-4,24,-6,18 &
],[nIPneighbor(cellType(10)),nIP(10)])
! MD: probably not needed END
! --------------------------------------------------------------------------------------------------
real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = &
reshape(real([&
@ -798,8 +806,6 @@ module element
contains
subroutine tElement_init(self,elemType)
use IO, only: &
IO_error
class(tElement) :: self
integer, intent(in) :: elemType

8
src/future.f90
View File

@ -3,7 +3,11 @@
!> @brief New fortran functions for compiler versions that do not support them
!--------------------------------------------------------------------------------------------------
module future
use prec
implicit none
public
contains
#if defined(__GFORTRAN__) || __INTEL_COMPILER < 1800
@ -11,6 +15,7 @@ contains
!> @brief substitute for the findloc intrinsic (only for integer, dimension(:) at the moment)
!--------------------------------------------------------------------------------------------------
function findloc(a,v)
integer, intent(in), dimension(:) :: a
integer, intent(in) :: v
integer :: i,j
@ -32,10 +37,7 @@ end function findloc
!> @brief substitute for the norm2 intrinsic (only for real, dimension(3) at the moment)
!--------------------------------------------------------------------------------------------------
real(pReal) pure function norm2(v)
use prec, only: &
pReal
implicit none
real(pReal), intent(in), dimension(3) :: v
norm2 = sqrt(sum(v**2))

91
src/geometry_plastic_nonlocal.f90
View File

@ -10,43 +10,106 @@ module geometry_plastic_nonlocal
implicit none
private
logical, dimension(3), public, parameter :: &
geometry_plastic_nonlocal_periodicSurface = .true. !< flag indicating periodic outer surfaces (used for fluxes) NEEDED?
integer, public, protected :: &
geometry_plastic_nonlocal_nIPneighbors
integer, dimension(:,:,:,:), allocatable, public, protected :: &
geometry_plastic_nonlocal_IPneighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
geometry_plastic_nonlocal_IPneighborhood !< 6 or less neighboring IPs as [element ID, IP ID, face ID that point to me]
real(pReal), dimension(:,:), allocatable, public, protected :: &
geometry_plastic_nonlocal_IPvolume !< volume associated with IP (initially!)
geometry_plastic_nonlocal_IPvolume0 !< volume associated with IP (initially!)
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
geometry_plastic_nonlocal_IParea !< area of interface to neighboring IP (initially!)
geometry_plastic_nonlocal_IParea0 !< area of interface to neighboring IP (initially!)
real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
geometry_plastic_nonlocal_IPareaNormal !< area normal of interface to neighboring IP (initially!)
geometry_plastic_nonlocal_IPareaNormal0 !< area normal of interface to neighboring IP (initially!)
public :: &
geometry_plastic_nonlocal_set_IPneighborhood, &
geometry_plastic_nonlocal_set_IPvolume
geometry_plastic_nonlocal_setIPneighborhood, &
geometry_plastic_nonlocal_setIPvolume, &
geometry_plastic_nonlocal_setIParea, &
geometry_plastic_nonlocal_setIPareaNormal, &
geometry_plastic_nonlocal_disable
contains
subroutine geometry_plastic_nonlocal_set_IPneighborhood(IPneighborhood)
!---------------------------------------------------------------------------------------------------
!> @brief Set the integration point (IP) neighborhood
!> @details: The IP neighborhood for element ID (last index), IP ID (second but last index) and
! face ID (second index) gives the element ID (1 @ first index), IP ID (2 @ first index)
! and face ID (3 @ first index).
! A triangle (2D) has 3 faces, a quadrilateral (2D) had 4 faces, a tetrahedron (3D) has
! 4 faces, and a hexahedron (3D) has 6 faces.
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood)
integer, dimension(:,:,:,:), intent(in) :: IPneighborhood
geometry_plastic_nonlocal_IPneighborhood = IPneighborhood
end subroutine geometry_plastic_nonlocal_set_IPneighborhood
geometry_plastic_nonlocal_nIPneighbors = size(IPneighborhood,2)
subroutine geometry_plastic_nonlocal_set_IPvolume(IPvolume)
end subroutine geometry_plastic_nonlocal_setIPneighborhood
!---------------------------------------------------------------------------------------------------
!> @brief Set the initial volume associated with an integration point
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_setIPvolume(IPvolume)
real(pReal), dimension(:,:), intent(in) :: IPvolume
geometry_plastic_nonlocal_IPvolume = IPvolume
geometry_plastic_nonlocal_IPvolume0 = IPvolume
end subroutine geometry_plastic_nonlocal_set_IPvolume
end subroutine geometry_plastic_nonlocal_setIPvolume
!---------------------------------------------------------------------------------------------------
!> @brief Set the initial areas of the unit triangle/unit quadrilateral/tetrahedron/hexahedron
! encompassing an integration point
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_setIParea(IParea)
real(pReal), dimension(:,:,:), intent(in) :: IParea
geometry_plastic_nonlocal_IParea0 = IParea
end subroutine geometry_plastic_nonlocal_setIParea
!---------------------------------------------------------------------------------------------------
!> @brief Set the direction normal of the areas of the triangle/quadrilateral/tetrahedron/hexahedron
! encompassing an integration point
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_setIPareaNormal(IPareaNormal)
real(pReal), dimension(:,:,:,:), intent(in) :: IPareaNormal
geometry_plastic_nonlocal_IPareaNormal0 = IPareaNormal
end subroutine geometry_plastic_nonlocal_setIPareaNormal
!---------------------------------------------------------------------------------------------------
!> @brief Frees memory used by variables only needed by plastic_nonlocal
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_disable
if(allocated(geometry_plastic_nonlocal_IPneighborhood)) &
deallocate(geometry_plastic_nonlocal_IPneighborhood)
if(allocated(geometry_plastic_nonlocal_IPvolume0)) &
deallocate(geometry_plastic_nonlocal_IPvolume0)
if(allocated(geometry_plastic_nonlocal_IParea0)) &
deallocate(geometry_plastic_nonlocal_IParea0)
if(allocated(geometry_plastic_nonlocal_IPareaNormal0)) &
deallocate(geometry_plastic_nonlocal_IPareaNormal0)
end subroutine geometry_plastic_nonlocal_disable
end module geometry_plastic_nonlocal

63
src/grid/grid_damage_spectral.f90
View File

@ -9,14 +9,17 @@ module grid_damage_spectral
#include <petsc/finclude/petscdmda.h>
use PETScdmda
use PETScsnes
use prec, only: &
pReal
use spectral_utilities, only: &
tSolutionState, &
tSolutionParams
use prec
use spectral_utilities
use mesh
use damage_nonlocal
use numerics
use damage_nonlocal
implicit none
private
!--------------------------------------------------------------------------------------------------
! derived types
type(tSolutionParams), private :: params
@ -51,18 +54,6 @@ contains
! ToDo: Restart not implemented
!--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_init
use spectral_utilities, only: &
wgt
use mesh, only: &
grid, &
grid3
use damage_nonlocal, only: &
damage_nonlocal_getDiffusion33, &
damage_nonlocal_getMobility
use numerics, only: &
worldrank, &
worldsize, &
petsc_options
PetscInt, dimension(worldsize) :: localK
integer :: i, j, k, cell
@ -153,15 +144,6 @@ end subroutine grid_damage_spectral_init
!> @brief solution for the spectral damage scheme with internal iterations
!--------------------------------------------------------------------------------------------------
function grid_damage_spectral_solution(timeinc,timeinc_old,loadCaseTime) result(solution)
use numerics, only: &
itmax, &
err_damage_tolAbs, &
err_damage_tolRel
use mesh, only: &
grid, &
grid3
use damage_nonlocal, only: &
damage_nonlocal_putNonLocalDamage
real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution
@ -223,16 +205,6 @@ end function grid_damage_spectral_solution
!> @brief spectral damage forwarding routine
!--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_forward
use mesh, only: &
grid, &
grid3
use spectral_utilities, only: &
cutBack, &
wgt
use damage_nonlocal, only: &
damage_nonlocal_putNonLocalDamage, &
damage_nonlocal_getDiffusion33, &
damage_nonlocal_getMobility
integer :: i, j, k, cell
DM :: dm_local
@ -278,25 +250,6 @@ end subroutine grid_damage_spectral_forward
!> @brief forms the spectral damage residual vector
!--------------------------------------------------------------------------------------------------
subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: &
residualStiffness
use mesh, only: &
grid, &
grid3
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
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in

110
src/grid/grid_mech_FEM.f90
View File

@ -11,13 +11,18 @@ module grid_mech_FEM
use HDF5_utilities
use PETScdmda
use PETScsnes
use prec, only: &
pReal
use math, only: &
math_I3
use spectral_utilities, only: &
tSolutionState, &
tSolutionParams
use prec
use CPFEM2
use IO
use debug
use FEsolving
use numerics
use homogenization
use DAMASK_interface
use spectral_utilities
use discretization
use mesh
use math
implicit none
private
@ -74,30 +79,6 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_FEM_init
use IO, only: &
IO_intOut, &
IO_error, &
IO_open_jobFile_binary
use FEsolving, only: &
restartInc
use numerics, only: &
worldrank, &
worldsize, &
petsc_options
use homogenization, only: &
materialpoint_F0
use DAMASK_interface, only: &
getSolverJobName
use spectral_utilities, only: &
utilities_constitutiveResponse, &
utilities_updateIPcoords, &
wgt
use mesh, only: &
geomSize, &
grid, &
grid3
use math, only: &
math_invSym3333
real(pReal) :: HGCoeff = 0e-2_pReal
PetscInt, dimension(:), allocatable :: localK
@ -243,14 +224,6 @@ end subroutine grid_mech_FEM_init
!> @brief solution for the FEM scheme with internal iterations
!--------------------------------------------------------------------------------------------------
function grid_mech_FEM_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution)
use IO, only: &
IO_error
use spectral_utilities, only: &
tBoundaryCondition, &
utilities_maskedCompliance
use FEsolving, only: &
restartWrite, &
terminallyIll
!--------------------------------------------------------------------------------------------------
! input data for solution
@ -304,25 +277,6 @@ end function grid_mech_FEM_solution
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_FEM_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: &
math_rotate_backward33
use numerics, only: &
worldrank
use homogenization, only: &
materialpoint_F0
use mesh, only: &
grid, &
grid3
use CPFEM2, only: &
CPFEM_age
use spectral_utilities, only: &
utilities_updateIPcoords, &
tBoundaryCondition, &
cutBack
use IO, only: &
IO_open_jobFile_binary
use FEsolving, only: &
restartWrite
logical, intent(in) :: &
guess
@ -422,17 +376,6 @@ end subroutine grid_mech_FEM_forward
!> @brief convergence check
!--------------------------------------------------------------------------------------------------
subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,ierr)
use mesh
use spectral_utilities
use numerics, only: &
itmax, &
itmin, &
err_div_tolRel, &
err_div_tolAbs, &
err_stress_tolRel, &
err_stress_tolAbs
use FEsolving, only: &
terminallyIll
SNES :: snes_local
PetscInt, intent(in) :: PETScIter
@ -481,28 +424,6 @@ end subroutine converged
!--------------------------------------------------------------------------------------------------
subroutine formResidual(da_local,x_local, &
f_local,dummy,ierr)
use numerics, only: &
itmax, &
itmin
use numerics, only: &
worldrank
use mesh, only: &
grid
use math, only: &
math_rotate_backward33, &
math_mul3333xx33
use debug, only: &
debug_level, &
debug_spectral, &
debug_spectralRotation
use spectral_utilities, only: &
utilities_constitutiveResponse
use IO, only: &
IO_intOut
use FEsolving, only: &
terminallyIll
use homogenization, only: &
materialpoint_dPdF
DM :: da_local
Vec :: x_local, f_local
@ -617,11 +538,6 @@ end subroutine formResidual
!> @brief forms the FEM stiffness matrix
!--------------------------------------------------------------------------------------------------
subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
use mesh, only: &
mesh_ipCoordinates
use homogenization, only: &
materialpoint_dPdF
DM :: da_local
Vec :: x_local, coordinates
@ -699,7 +615,7 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
ele = 0
do k = zstart, zend; do j = ystart, yend; do i = xstart, xend
ele = ele + 1
x_scal(0:2,i,j,k) = mesh_ipCoordinates(1:3,1,ele)
x_scal(0:2,i,j,k) = discretization_IPcoords(1:3,ele)
enddo; enddo; enddo
call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr) ! initialize to undeformed coordinates (ToDo: use ip coordinates)
call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr);CHKERRQ(ierr) ! get rigid body deformation modes

109
src/grid/grid_mech_spectral_basic.f90
View File

@ -7,17 +7,22 @@
module grid_mech_spectral_basic
#include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h>
use DAMASK_interface
use HDF5_utilities
use PETScdmda
use PETScsnes
use prec, only: &
pReal
use math, only: &
math_I3
use spectral_utilities, only: &
tSolutionState, &
tSolutionParams
use prec
use DAMASK_interface
use HDF5_utilities
use math
use spectral_utilities
use IO
use FEsolving
use config
use numerics
use homogenization
use mesh
use CPFEM2
use debug
implicit none
private
@ -81,31 +86,6 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_basic_init
use IO, only: &
IO_intOut, &
IO_error, &
IO_open_jobFile_binary
use FEsolving, only: &
restartInc
use config, only :&
config_numerics
use numerics, only: &
worldrank, &
worldsize, &
petsc_options
use homogenization, only: &
materialpoint_F0
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
real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
real(pReal), dimension(3,3) :: &
@ -215,13 +195,6 @@ end subroutine grid_mech_spectral_basic_init
!> @brief solution for the basic scheme with internal iterations
!--------------------------------------------------------------------------------------------------
function grid_mech_spectral_basic_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution)
use spectral_utilities, only: &
tBoundaryCondition, &
utilities_maskedCompliance, &
utilities_updateGamma
use FEsolving, only: &
restartWrite, &
terminallyIll
!--------------------------------------------------------------------------------------------------
! input data for solution
@ -277,27 +250,6 @@ end function grid_mech_spectral_basic_solution
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: &
math_rotate_backward33
use numerics, only: &
worldrank
use homogenization, only: &
materialpoint_F0
use mesh, only: &
grid, &
grid3
use CPFEM2, only: &
CPFEM_age
use spectral_utilities, only: &
utilities_calculateRate, &
utilities_forwardField, &
utilities_updateIPcoords, &
tBoundaryCondition, &
cutBack
use IO, only: &
IO_open_jobFile_binary
use FEsolving, only: &
restartWrite
logical, intent(in) :: &
guess
@ -387,15 +339,6 @@ end subroutine grid_mech_spectral_basic_forward
!> @brief convergence check
!--------------------------------------------------------------------------------------------------
subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dummy,ierr)
use numerics, only: &
itmax, &
itmin, &
err_div_tolRel, &
err_div_tolAbs, &
err_stress_tolRel, &
err_stress_tolAbs
use FEsolving, only: &
terminallyIll
SNES :: snes_local
PetscInt, intent(in) :: PETScIter
@ -442,30 +385,6 @@ end subroutine converged
!--------------------------------------------------------------------------------------------------
subroutine formResidual(in, F, &
residuum, dummy, ierr)
use numerics, only: &
itmax, &
itmin
use mesh, only: &
grid, &
grid3
use math, only: &
math_rotate_backward33, &
math_mul3333xx33
use debug, only: &
debug_level, &
debug_spectral, &
debug_spectralRotation
use spectral_utilities, only: &
tensorField_real, &
utilities_FFTtensorForward, &
utilities_fourierGammaConvolution, &
utilities_FFTtensorBackward, &
utilities_constitutiveResponse, &
utilities_divergenceRMS
use IO, only: &
IO_intOut
use FEsolving, only: &
terminallyIll
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in !< DMDA info (needs to be named "in" for macros like XRANGE to work)
PetscScalar, dimension(3,3,XG_RANGE,YG_RANGE,ZG_RANGE), &

122
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -7,17 +7,22 @@
module grid_mech_spectral_polarisation
#include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h>
use DAMASK_interface
use HDF5_utilities
use PETScdmda
use PETScsnes
use prec, only: &
pReal
use math, only: &
math_I3
use spectral_utilities, only: &
tSolutionState, &
tSolutionParams
use prec
use DAMASK_interface
use HDF5_utilities
use math
use spectral_utilities
use IO
use FEsolving
use config
use numerics
use homogenization
use mesh
use CPFEM2
use debug
implicit none
private
@ -87,31 +92,6 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_polarisation_init
use IO, only: &
IO_intOut, &
IO_error, &
IO_open_jobFile_binary
use FEsolving, only: &
restartInc
use config, only :&
config_numerics
use numerics, only: &
worldrank, &
worldsize, &
petsc_options
use homogenization, only: &
materialpoint_F0
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
real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
real(pReal), dimension(3,3) :: &
@ -230,15 +210,6 @@ end subroutine grid_mech_spectral_polarisation_init
!> @brief solution for the Polarisation scheme with internal iterations
!--------------------------------------------------------------------------------------------------
function grid_mech_spectral_polarisation_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution)
use math, only: &
math_invSym3333
use spectral_utilities, only: &
tBoundaryCondition, &
utilities_maskedCompliance, &
utilities_updateGamma
use FEsolving, only: &
restartWrite, &
terminallyIll
!--------------------------------------------------------------------------------------------------
! input data for solution
@ -298,28 +269,6 @@ end function grid_mech_spectral_polarisation_solution
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: &
math_mul3333xx33, &
math_rotate_backward33
use numerics, only: &
worldrank
use homogenization, only: &
materialpoint_F0
use mesh, only: &
grid, &
grid3
use CPFEM2, only: &
CPFEM_age
use spectral_utilities, only: &
utilities_calculateRate, &
utilities_forwardField, &
utilities_updateIPcoords, &
tBoundaryCondition, &
cutBack
use IO, only: &
IO_open_jobFile_binary
use FEsolving, only: &
restartWrite
logical, intent(in) :: &
guess
@ -434,17 +383,6 @@ end subroutine grid_mech_spectral_polarisation_forward
!> @brief convergence check
!--------------------------------------------------------------------------------------------------
subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dummy,ierr)
use numerics, only: &
itmax, &
itmin, &
err_div_tolRel, &
err_div_tolAbs, &
err_curl_tolRel, &
err_curl_tolAbs, &
err_stress_tolRel, &
err_stress_tolAbs
use FEsolving, only: &
terminallyIll
SNES :: snes_local
PetscInt, intent(in) :: PETScIter
@ -496,38 +434,6 @@ end subroutine converged
!--------------------------------------------------------------------------------------------------
subroutine formResidual(in, FandF_tau, &
residuum, dummy,ierr)
use numerics, only: &
itmax, &
itmin, &
polarAlpha, &
polarBeta
use mesh, only: &
grid, &
grid3
use math, only: &
math_rotate_forward33, &
math_rotate_backward33, &
math_mul3333xx33, &
math_invSym3333
use debug, only: &
debug_level, &
debug_spectral, &
debug_spectralRotation
use spectral_utilities, only: &
wgt, &
tensorField_real, &
utilities_FFTtensorForward, &
utilities_fourierGammaConvolution, &
utilities_FFTtensorBackward, &
utilities_constitutiveResponse, &
utilities_divergenceRMS, &
utilities_curlRMS
use IO, only: &
IO_intOut
use homogenization, only: &
materialpoint_dPdF
use FEsolving, only: &
terminallyIll
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in !< DMDA info (needs to be named "in" for macros like XRANGE to work)
PetscScalar, dimension(3,3,2,XG_RANGE,YG_RANGE,ZG_RANGE), &

68
src/grid/grid_thermal_spectral.f90
View File

@ -9,14 +9,17 @@ module grid_thermal_spectral
#include <petsc/finclude/petscdmda.h>
use PETScdmda
use PETScsnes
use prec, only: &
pReal
use spectral_utilities, only: &
tSolutionState, &
tSolutionParams
use prec
use spectral_utilities
use mesh
use thermal_conduction
use material
use numerics
implicit none
private
!--------------------------------------------------------------------------------------------------
! derived types
type(tSolutionParams), private :: params
@ -51,23 +54,6 @@ contains
! ToDo: Restart not implemented
!--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_init
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: &
material_homogenizationAt, &
temperature, &
thermalMapping
use numerics, only: &
worldrank, &
worldsize, &
petsc_options
PetscInt, dimension(worldsize) :: localK
integer :: i, j, k, cell
@ -156,15 +142,6 @@ end subroutine grid_thermal_spectral_init
!> @brief solution for the spectral thermal scheme with internal iterations
!--------------------------------------------------------------------------------------------------
function grid_thermal_spectral_solution(timeinc,timeinc_old,loadCaseTime) result(solution)
use numerics, only: &
itmax, &
err_thermal_tolAbs, &
err_thermal_tolRel
use mesh, only: &
grid, &
grid3
use thermal_conduction, only: &
thermal_conduction_putTemperatureAndItsRate
real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution
@ -228,17 +205,6 @@ end function grid_thermal_spectral_solution
!> @brief forwarding routine
!--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_forward
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
integer :: i, j, k, cell
DM :: dm_local
@ -289,24 +255,6 @@ end subroutine grid_thermal_spectral_forward
!> @brief forms the spectral thermal residual vector
!--------------------------------------------------------------------------------------------------
subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
use mesh, only: &
grid, &
grid3
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
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in

136
src/grid/spectral_utilities.f90
View File

@ -7,14 +7,20 @@ module spectral_utilities
use, intrinsic :: iso_c_binding
#include <petsc/finclude/petscsys.h>
use PETScSys
use prec, only: &
pReal, &
pStringLen
use math, only: &
math_I3
use prec
use math
use IO
use mesh
use numerics
use debug
use config
use discretization
use homogenization
implicit none
private
include 'fftw3-mpi.f03'
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
@ -170,31 +176,6 @@ contains
!> Initializes FFTW.
!--------------------------------------------------------------------------------------------------
subroutine utilities_init
use IO, only: &
IO_error, &
IO_warning, &
IO_lc
use numerics, only: &
petsc_defaultOptions, &
petsc_options
use debug, only: &
debug_level, &
debug_SPECTRAL, &
debug_LEVELBASIC, &
debug_SPECTRALDIVERGENCE, &
debug_SPECTRALFFTW, &
debug_SPECTRALPETSC, &
debug_SPECTRALROTATION
use config, only: &
config_numerics
use debug, only: &
PETSCDEBUG
use math
use mesh, only: &
grid, &
grid3, &
grid3Offset, &
geomSize
PetscErrorCode :: ierr
integer :: i, j, k, &
@ -412,17 +393,6 @@ end subroutine utilities_init
!> Also writes out the current reference stiffness for restart.
!---------------------------------------------------------------------------------------------------
subroutine utilities_updateGamma(C,saveReference)
use IO, only: &
IO_open_jobFile_binary
use numerics, only: &
worldrank
use mesh, only: &
grid3Offset, &
grid3,&
grid
use math, only: &
math_det33, &
math_invert2
real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
logical , intent(in) :: saveReference !< save reference stiffness to file for restart
@ -538,13 +508,6 @@ end subroutine utilities_FFTvectorBackward
!> @brief doing convolution gamma_hat * field_real, ensuring that average value = fieldAim
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierGammaConvolution(fieldAim)
use math, only: &
math_det33, &
math_invert2
use mesh, only: &
grid3, &
grid, &
grid3Offset
real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx
@ -600,11 +563,6 @@ end subroutine utilities_fourierGammaConvolution
!> @brief doing convolution DamageGreenOp_hat * field_real
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierGreenConvolution(D_ref, mobility_ref, deltaT)
use math, only: &
PI
use mesh, only: &
grid, &
grid3
real(pReal), dimension(3,3), intent(in) :: D_ref
real(pReal), intent(in) :: mobility_ref, deltaT
@ -627,12 +585,6 @@ end subroutine utilities_fourierGreenConvolution
!> @brief calculate root mean square of divergence of field_fourier
!--------------------------------------------------------------------------------------------------
real(pReal) function utilities_divergenceRMS()
use IO, only: &
IO_error
use mesh, only: &
geomSize, &
grid, &
grid3
integer :: i, j, k, ierr
complex(pReal), dimension(3) :: rescaledGeom
@ -676,12 +628,6 @@ end function utilities_divergenceRMS
!> @brief calculate max of curl of field_fourier
!--------------------------------------------------------------------------------------------------
real(pReal) function utilities_curlRMS()
use IO, only: &
IO_error
use mesh, only: &
geomSize, &
grid, &
grid3
integer :: i, j, k, l, ierr
complex(pReal), dimension(3,3) :: curl_fourier
@ -743,16 +689,6 @@ end function utilities_curlRMS
!> @brief calculates mask compliance tensor used to adjust F to fullfill stress BC
!--------------------------------------------------------------------------------------------------
function utilities_maskedCompliance(rot_BC,mask_stress,C)
use, intrinsic :: &
IEEE_arithmetic
use IO, only: &
IO_error
use math, only: &
math_3333to99, &
math_99to3333, &
math_rotate_forward3333, &
math_rotate_forward33, &
math_invert2
real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance
real(pReal), intent(in) , dimension(3,3,3,3) :: C !< current average stiffness
@ -844,9 +780,6 @@ end function utilities_maskedCompliance
!> @brief calculate scalar gradient in fourier field
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierScalarGradient()
use mesh, only: &
grid3, &
grid
integer :: i, j, k
@ -861,9 +794,6 @@ end subroutine utilities_fourierScalarGradient
!> @brief calculate vector divergence in fourier field
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierVectorDivergence()
use mesh, only: &
grid3, &
grid
integer :: i, j, k
@ -879,9 +809,6 @@ end subroutine utilities_fourierVectorDivergence
!> @brief calculate vector gradient in fourier field
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierVectorGradient()
use mesh, only: &
grid3, &
grid
integer :: i, j, k, m, n
@ -899,9 +826,6 @@ end subroutine utilities_fourierVectorGradient
!> @brief calculate tensor divergence in fourier field
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierTensorDivergence()
use mesh, only: &
grid3, &
grid
integer :: i, j, k, m, n
@ -921,21 +845,6 @@ end subroutine utilities_fourierTensorDivergence
!--------------------------------------------------------------------------------------------------
subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
F,timeinc,rotation_BC)
use IO, only: &
IO_error
use numerics, only: &
worldrank
use math, only: &
math_rotate_forward33, &
math_det33
use mesh, only: &
grid,&
grid3
use homogenization, only: &
materialpoint_F, &
materialpoint_P, &
materialpoint_dPdF, &
materialpoint_stressAndItsTangent
real(pReal),intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
@ -1010,9 +919,6 @@ end subroutine utilities_constitutiveResponse
!> @brief calculates forward rate, either guessing or just add delta/timeinc
!--------------------------------------------------------------------------------------------------
pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate)
use mesh, only: &
grid3, &
grid
real(pReal), intent(in), dimension(3,3) :: &
avRate !< homogeneous addon
@ -1040,9 +946,6 @@ end function utilities_calculateRate
!> ensures that the average matches the aim
!--------------------------------------------------------------------------------------------------
function utilities_forwardField(timeinc,field_lastInc,rate,aim)
use mesh, only: &
grid3, &
grid
real(pReal), intent(in) :: &
timeinc !< timeinc of current step
@ -1074,11 +977,6 @@ end function utilities_forwardField
! standard approach
!--------------------------------------------------------------------------------------------------
pure function utilities_getFreqDerivative(k_s)
use math, only: &
PI
use mesh, only: &
geomSize, &
grid
integer, intent(in), dimension(3) :: k_s !< indices of frequency
complex(pReal), dimension(3) :: utilities_getFreqDerivative
@ -1127,16 +1025,6 @@ end function utilities_getFreqDerivative
! convolution
!--------------------------------------------------------------------------------------------------
subroutine utilities_updateIPcoords(F)
use prec, only: &
cNeq
use IO, only: &
IO_error
use mesh, only: &
grid, &
grid3, &
grid3Offset, &
geomSize, &
mesh_ipCoordinates
real(pReal), dimension(3,3,grid(1),grid(2),grid3), intent(in) :: F
integer :: i, j, k, m, ierr
@ -1179,6 +1067,8 @@ subroutine utilities_updateIPcoords(F)
m = m+1
enddo; enddo; enddo
call discretization_setIPcoords(reshape(mesh_ipCoordinates,[3,grid(1)*grid(2)*grid3]))
end subroutine utilities_updateIPcoords
end module spectral_utilities

96
src/homogenization.f90
View File

@ -14,23 +14,23 @@ module homogenization
use numerics
use constitutive
use crystallite
use mesh
use FEsolving
use mesh
use discretization
use thermal_isothermal
use thermal_adiabatic
use thermal_conduction
use damage_none
use damage_local
use damage_nonlocal
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
use HDF5_utilities
#endif
implicit none
private
!--------------------------------------------------------------------------------------------------
! General variables for the homogenization at a material point
implicit none
private
real(pReal), dimension(:,:,:,:), allocatable, public :: &
materialpoint_F0, & !< def grad of IP at start of FE increment
materialpoint_F, & !< def grad of IP to be reached at end of FE increment
@ -44,17 +44,17 @@ module homogenization
thermal_maxSizePostResults, &
damage_maxSizePostResults
real(pReal), dimension(:,:,:,:), allocatable, private :: &
real(pReal), dimension(:,:,:,:), allocatable :: &
materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment
materialpoint_subF !< def grad of IP to be reached at end of homog inc
real(pReal), dimension(:,:), allocatable, private :: &
real(pReal), dimension(:,:), allocatable :: &
materialpoint_subFrac, &
materialpoint_subStep, &
materialpoint_subdt
logical, dimension(:,:), allocatable, private :: &
logical, dimension(:,:), allocatable :: &
materialpoint_requested, &
materialpoint_converged
logical, dimension(:,:,:), allocatable, private :: &
logical, dimension(:,:,:), allocatable :: &
materialpoint_doneAndHappy
interface
@ -236,20 +236,20 @@ subroutine homogenization_init
!--------------------------------------------------------------------------------------------------
! allocate and initialize global variables
allocate(materialpoint_dPdF(3,3,3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_F0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems) ! initialize to identity
allocate(materialpoint_F(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_dPdF(3,3,3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_F0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
materialpoint_F0 = spread(spread(math_I3,3,discretization_nIP),4,discretization_nElem) ! initialize to identity
allocate(materialpoint_F(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
materialpoint_F = materialpoint_F0 ! initialize to identity
allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subF(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_P(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subFrac(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subStep(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subdt(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_requested(theMesh%elem%nIPs,theMesh%nElems), source=.false.)
allocate(materialpoint_converged(theMesh%elem%nIPs,theMesh%nElems), source=.true.)
allocate(materialpoint_doneAndHappy(2,theMesh%elem%nIPs,theMesh%nElems), source=.true.)
allocate(materialpoint_subF0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subF(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subFrac(discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subStep(discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subdt(discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_requested(discretization_nIP,discretization_nElem), source=.false.)
allocate(materialpoint_converged(discretization_nIP,discretization_nElem), source=.true.)
allocate(materialpoint_doneAndHappy(2,discretization_nIP,discretization_nElem), source=.true.)
!--------------------------------------------------------------------------------------------------
! allocate and initialize global state and postresutls variables
@ -266,7 +266,7 @@ subroutine homogenization_init
+ homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results
+ 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results
+ constitutive_source_maxSizePostResults)
allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems))
allocate(materialpoint_results(materialpoint_sizeResults,discretization_nIP,discretization_nElem))
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
@ -286,7 +286,7 @@ subroutine homogenization_init
endif
flush(6)
if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) &
if (debug_g < 1 .or. debug_g > homogenization_Ngrains(material_homogenizationAt(debug_e))) &
call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g)
end subroutine homogenization_init
@ -322,7 +322,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
!--------------------------------------------------------------------------------------------------
! initialize restoration points of ...
do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(mesh_element(3,e))
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e);
do g = 1,myNgrains
@ -370,7 +370,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
!$OMP PARALLEL DO PRIVATE(myNgrains)
elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(mesh_element(3,e))
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
converged: if (materialpoint_converged(i,e)) then
@ -521,7 +521,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
! results in crystallite_partionedF
!$OMP PARALLEL DO PRIVATE(myNgrains)
elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(mesh_element(3,e))
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
if ( materialpoint_requested(i,e) .and. & ! process requested but...
.not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points
@ -600,8 +600,8 @@ subroutine materialpoint_postResults
!$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize)
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(mesh_element(3,e))
myCrystallite = microstructure_crystallite(mesh_element(4,e))
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
myCrystallite = microstructure_crystallite(discretization_microstructureAt(e))
IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
thePos = 0
@ -642,19 +642,19 @@ subroutine partitionDeformation(ip,el)
ip, & !< integration point
el !< element number
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
crystallite_partionedF(1:3,1:3,1,ip,el) = materialpoint_subF(1:3,1:3,ip,el)
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
call mech_isostrain_partitionDeformation(&
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
materialpoint_subF(1:3,1:3,ip,el))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call mech_RGC_partitionDeformation(&
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
materialpoint_subF(1:3,1:3,ip,el),&
ip, &
el)
@ -675,21 +675,21 @@ function updateState(ip,el)
logical, dimension(2) :: updateState
updateState = .true.
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
updateState = &
updateState .and. &
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),&
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el),&
materialpoint_subF(1:3,1:3,ip,el),&
materialpoint_subdt(ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
ip, &
el)
end select chosenHomogenization
chosenThermal: select case (thermal_type(mesh_element(3,el)))
chosenThermal: select case (thermal_type(material_homogenizationAt(el)))
case (THERMAL_adiabatic_ID) chosenThermal
updateState = &
updateState .and. &
@ -698,7 +698,7 @@ function updateState(ip,el)
el)
end select chosenThermal
chosenDamage: select case (damage_type(mesh_element(3,el)))
chosenDamage: select case (damage_type(material_homogenizationAt(el)))
case (DAMAGE_local_ID) chosenDamage
updateState = &
updateState .and. &
@ -719,7 +719,7 @@ subroutine averageStressAndItsTangent(ip,el)
ip, & !< integration point
el !< element number
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
materialpoint_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el)
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_dPdF(1:3,1:3,1:3,1:3,1,ip,el)
@ -728,17 +728,17 @@ subroutine averageStressAndItsTangent(ip,el)
call mech_isostrain_averageStressAndItsTangent(&
materialpoint_P(1:3,1:3,ip,el), &
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
homogenization_typeInstance(mesh_element(3,el)))
crystallite_P(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
homogenization_typeInstance(material_homogenizationAt(el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call mech_RGC_averageStressAndItsTangent(&
materialpoint_P(1:3,1:3,ip,el), &
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
homogenization_typeInstance(mesh_element(3,el)))
crystallite_P(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
homogenization_typeInstance(material_homogenizationAt(el)))
end select chosenHomogenization
end subroutine averageStressAndItsTangent
@ -765,7 +765,7 @@ function postResults(ip,el)
postResults = 0.0_pReal
startPos = 1
endPos = thermalState(material_homogenizationAt(el))%sizePostResults
chosenThermal: select case (thermal_type(mesh_element(3,el)))
chosenThermal: select case (thermal_type(material_homogenizationAt(el)))
case (THERMAL_adiabatic_ID) chosenThermal
homog = material_homogenizationAt(el)
@ -780,7 +780,7 @@ function postResults(ip,el)
startPos = endPos + 1
endPos = endPos + damageState(material_homogenizationAt(el))%sizePostResults
chosenDamage: select case (damage_type(mesh_element(3,el)))
chosenDamage: select case (damage_type(material_homogenizationAt(el)))
case (DAMAGE_local_ID) chosenDamage
postResults(startPos:endPos) = damage_local_postResults(ip, el)

218
src/material.f90
View File

@ -11,9 +11,17 @@ module material
use prec
use math
use config
use results
use IO
use debug
use mesh
use numerics
use rotations
use discretization
implicit none
private
character(len=*), parameter, public :: &
ELASTICITY_hooke_label = 'hooke', &
PLASTICITY_none_label = 'none', &
@ -122,7 +130,7 @@ module material
! NEW MAPPINGS
integer, dimension(:), allocatable, public, protected :: & ! (elem)
material_homogenizationAt !< homogenization ID of each element (copy of mesh_homogenizationAt)
material_homogenizationAt !< homogenization ID of each element (copy of discretization_homogenizationAt)
integer, dimension(:,:), allocatable, public, protected :: & ! (ip,elem)
material_homogenizationMemberAt !< position of the element within its homogenization instance
integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem)
@ -145,34 +153,28 @@ module material
damageState
integer, dimension(:,:,:), allocatable, public, protected :: &
material_texture !< texture (index) of each grain,IP,element
material_texture !< texture (index) of each grain,IP,element. Only used by plastic_nonlocal
real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
material_EulerAngles !< initial orientation of each grain,IP,element
logical, dimension(:), allocatable, public, protected :: &
microstructure_active, &
microstructure_elemhomo, & !< flag to indicate homogeneous microstructure distribution over element's IPs
phase_localPlasticity !< flags phases with local constitutive law
integer, private :: &
microstructure_maxNconstituents, & !< max number of constituents in any phase
texture_maxNgauss !< max number of Gauss components in any texture
microstructure_maxNconstituents !< max number of constituents in any phase
integer, dimension(:), allocatable, private :: &
microstructure_Nconstituents, & !< number of constituents in each microstructure
texture_Ngauss !< number of Gauss components per texture
microstructure_Nconstituents !< number of constituents in each microstructure
integer, dimension(:,:), allocatable, private :: &
microstructure_phase, & !< phase IDs of each microstructure
microstructure_texture !< texture IDs of each microstructure
real(pReal), dimension(:,:), allocatable, private :: &
microstructure_fraction !< vol fraction of each constituent in microstructure
real(pReal), dimension(:,:,:), allocatable, private :: &
texture_Gauss, & !< data of each Gauss component
texture_transformation !< transformation for each texture
microstructure_fraction !< vol fraction of each constituent in microstructure
logical, dimension(:), allocatable, private :: &
homogenization_active
@ -243,18 +245,6 @@ contains
!> material.config
!--------------------------------------------------------------------------------------------------
subroutine material_init
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
#endif
use IO, only: &
IO_error
use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic, &
debug_levelExtensive
use mesh, only: &
theMesh
integer, parameter :: FILEUNIT = 210
integer :: m,c,h, myDebug, myPhase, myHomog
@ -323,12 +313,11 @@ subroutine material_init
do h = 1,size(config_homogenization)
write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h)
enddo
write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous'
write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents'
do m = 1,size(config_microstructure)
write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), &
write(6,'(1x,a32,1x,i11,1x,i12)') microstructure_name(m), &
microstructure_crystallite(m), &
microstructure_Nconstituents(m), &
microstructure_elemhomo(m)
microstructure_Nconstituents(m)
if (microstructure_Nconstituents(m) > 0) then
do c = 1,microstructure_Nconstituents(m)
write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),&
@ -344,12 +333,12 @@ subroutine material_init
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! new mappings
allocate(material_homogenizationAt,source=theMesh%homogenizationAt)
allocate(material_homogenizationMemberAt(theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(material_homogenizationAt,source=discretization_homogenizationAt)
allocate(material_homogenizationMemberAt(discretization_nIP,discretization_nElem),source=0)
allocate(CounterHomogenization(size(config_homogenization)),source=0)
do e = 1, theMesh%Nelems
do i = 1, theMesh%elem%nIPs
do e = 1, discretization_nElem
do i = 1, discretization_nIP
CounterHomogenization(material_homogenizationAt(e)) = &
CounterHomogenization(material_homogenizationAt(e)) + 1
material_homogenizationMemberAt(i,e) = CounterHomogenization(material_homogenizationAt(e))
@ -357,12 +346,12 @@ subroutine material_init
enddo
allocate(material_phaseAt(homogenization_maxNgrains,theMesh%Nelems), source=material_phase(:,1,:))
allocate(material_phaseMemberAt(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(material_phaseAt(homogenization_maxNgrains,discretization_nElem), source=material_phase(:,1,:))
allocate(material_phaseMemberAt(homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
allocate(CounterPhase(size(config_phase)),source=0)
do e = 1, theMesh%Nelems
do i = 1, theMesh%elem%nIPs
do e = 1, discretization_nElem
do i = 1, discretization_nIP
do c = 1, homogenization_maxNgrains
CounterPhase(material_phaseAt(c,e)) = &
CounterPhase(material_phaseAt(c,e)) + 1
@ -371,6 +360,9 @@ subroutine material_init
enddo
enddo
call config_deallocate('material.config/microstructure')
call config_deallocate('material.config/texture')
#if defined(PETSc) || defined(DAMASK_HDF5)
call results_openJobFile
call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,phase_name)
@ -383,18 +375,18 @@ subroutine material_init
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN DEPRECATED
allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1)
allocate(phaseAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
allocate(phasememberAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
allocate(mappingHomogenization (2, discretization_nIP,discretization_nElem),source=0)
allocate(mappingHomogenizationConst( discretization_nIP,discretization_nElem),source=1)
CounterHomogenization=0
CounterPhase =0
do e = 1,theMesh%Nelems
myHomog = theMesh%homogenizationAt(e)
do i = 1, theMesh%elem%nIPs
do e = 1,discretization_nElem
myHomog = discretization_homogenizationAt(e)
do i = 1, discretization_nIP
CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1
mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)]
do g = 1,homogenization_Ngrains(myHomog)
@ -424,10 +416,6 @@ end subroutine material_init
!> @brief parses the homogenization part from the material configuration
!--------------------------------------------------------------------------------------------------
subroutine material_parseHomogenization
use mesh, only: &
theMesh
use IO, only: &
IO_error
integer :: h
character(len=65536) :: tag
@ -445,7 +433,7 @@ subroutine material_parseHomogenization
allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal)
forall (h = 1:size(config_homogenization)) &
homogenization_active(h) = any(theMesh%homogenizationAt == h)
homogenization_active(h) = any(discretization_homogenizationAt == h)
do h=1, size(config_homogenization)
@ -519,14 +507,6 @@ end subroutine material_parseHomogenization
!> @brief parses the microstructure part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parseMicrostructure
use IO, only: &
IO_floatValue, &
IO_intValue, &
IO_stringValue, &
IO_stringPos, &
IO_error
use mesh, only: &
theMesh
character(len=65536), dimension(:), allocatable :: &
strings
@ -538,18 +518,16 @@ subroutine material_parseMicrostructure
allocate(microstructure_crystallite(size(config_microstructure)), source=0)
allocate(microstructure_Nconstituents(size(config_microstructure)), source=0)
allocate(microstructure_active(size(config_microstructure)), source=.false.)
allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.)
if(any(theMesh%microstructureAt > size(config_microstructure))) &
if(any(discretization_microstructureAt > size(config_microstructure))) &
call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config')
forall (e = 1:theMesh%Nelems) &
microstructure_active(theMesh%microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
forall (e = 1:discretization_nElem) &
microstructure_active(discretization_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
do m=1, size(config_microstructure)
microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)')
microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite')
microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/')
enddo
microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
@ -577,12 +555,9 @@ subroutine material_parseMicrostructure
enddo
enddo
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg=microstructure_name(m))
enddo
do m = 1, size(config_microstructure)
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) &
call IO_error(153,ext_msg=microstructure_name(m))
enddo
end subroutine material_parseMicrostructure
@ -606,10 +581,6 @@ end subroutine material_parseCrystallite
!> @brief parses the phase part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parsePhase
use IO, only: &
IO_error, &
IO_getTag, &
IO_stringValue
integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
character(len=65536), dimension(:), allocatable :: str
@ -729,81 +700,71 @@ subroutine material_parsePhase
end subroutine material_parsePhase
!--------------------------------------------------------------------------------------------------
!> @brief parses the texture part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parseTexture
use IO, only: &
IO_error, &
IO_stringPos, &
IO_floatValue, &
IO_stringValue
integer :: section, gauss, j, t, i
integer :: j, t, i
character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config
integer, dimension(:), allocatable :: chunkPos
allocate(texture_Ngauss(size(config_texture)), source=0)
real(pReal), dimension(3,3) :: texture_transformation ! maps texture to microstructure coordinate system
type(rotation) :: eulers
do t=1, size(config_texture)
texture_Ngauss(t) = config_texture(t)%countKeys('(gauss)')
if (config_texture(t)%countKeys('(gauss)') /= 1) call IO_error(147,ext_msg='count((gauss)) != 1')
if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry')
if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)')
if (config_texture(t)%keyExists('(fiber)')) call IO_error(147,ext_msg='(fiber)')
enddo
texture_maxNgauss = maxval(texture_Ngauss)
allocate(texture_Gauss (5,texture_maxNgauss,size(config_texture)), source=0.0_pReal)
allocate(texture_transformation(3,3,size(config_texture)), source=0.0_pReal)
texture_transformation = spread(math_I3,3,size(config_texture))
allocate(texture_Gauss (3,size(config_texture)), source=0.0_pReal)
do t=1, size(config_texture)
section = t
gauss = 0
if (config_texture(t)%keyExists('axes')) then
strings = config_texture(t)%getStrings('axes')
do j = 1, 3 ! look for "x", "y", and "z" entries
select case (strings(j))
case('x', '+x')
texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
case('-x')
texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis
case('y', '+y')
texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis
case('-y')
texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis
case('z', '+z')
texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis
case('-z')
texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
case default
call IO_error(157,t)
end select
enddo
if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157,t)
endif
if (config_texture(t)%keyExists('(gauss)')) then
gauss = gauss + 1
strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
do i = 1 , size(strings)
chunkPos = IO_stringPos(strings(i))
do j = 1,9,2
select case (IO_stringValue(strings(i),chunkPos,j))
case('phi1')
texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
texture_Gauss(1,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
case('phi')
texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
texture_Gauss(2,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
case('phi2')
texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
texture_Gauss(3,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
end select
enddo
enddo
if (config_texture(t)%keyExists('axes')) then
strings = config_texture(t)%getStrings('axes')
do j = 1, 3 ! look for "x", "y", and "z" entries
select case (strings(j))
case('x', '+x')
texture_transformation(j,1:3) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
case('-x')
texture_transformation(j,1:3) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis
case('y', '+y')
texture_transformation(j,1:3) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis
case('-y')
texture_transformation(j,1:3) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis
case('z', '+z')
texture_transformation(j,1:3) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis
case('-z')
texture_transformation(j,1:3) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
case default
call IO_error(157,t)
end select
enddo
if(dNeq(math_det33(texture_transformation),1.0_pReal)) call IO_error(157,t)
call eulers%fromEulerAngles(texture_Gauss(:,t))
texture_Gauss(:,t) = math_RtoEuler(matmul(eulers%asRotationMatrix(),texture_transformation))
endif
enddo
call config_deallocate('material.config/texture')
end subroutine material_parseTexture
@ -814,8 +775,6 @@ end subroutine material_parseTexture
subroutine material_allocatePlasticState(phase,NofMyPhase,&
sizeState,sizeDotState,sizeDeltaState,&
Nslip,Ntwin,Ntrans)
use numerics, only: &
numerics_integrator
integer, intent(in) :: &
phase, &
@ -861,8 +820,6 @@ end subroutine material_allocatePlasticState
!--------------------------------------------------------------------------------------------------
subroutine material_allocateSourceState(phase,of,NofMyPhase,&
sizeState,sizeDotState,sizeDeltaState)
use numerics, only: &
numerics_integrator
integer, intent(in) :: &
phase, &
@ -902,36 +859,27 @@ end subroutine material_allocateSourceState
!! calculates the volume of the grains and deals with texture components
!--------------------------------------------------------------------------------------------------
subroutine material_populateGrains
use mesh, only: &
theMesh
integer :: e,i,c,homog,micro
allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0)
allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0)
allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal)
allocate(material_phase(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0)
allocate(material_texture(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0)
allocate(material_EulerAngles(3,homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0.0_pReal)
do e = 1, theMesh%Nelems
do i = 1, theMesh%elem%nIPs
homog = theMesh%homogenizationAt(e)
micro = theMesh%microstructureAt(e)
do e = 1, discretization_nElem
do i = 1, discretization_nIP
homog = discretization_homogenizationAt(e)
micro = discretization_microstructureAt(e)
do c = 1, homogenization_Ngrains(homog)
material_phase(c,i,e) = microstructure_phase(c,micro)
material_texture(c,i,e) = microstructure_texture(c,micro)
material_EulerAngles(1:3,c,i,e) = texture_Gauss(1:3,1,material_texture(c,i,e))
material_EulerAngles(1:3,c,i,e) = math_RtoEuler( & ! translate back to Euler angles
matmul( & ! pre-multiply
math_EulertoR(material_EulerAngles(1:3,c,i,e)), & ! face-value orientation
texture_transformation(1:3,1:3,material_texture(c,i,e)) & ! and transformation matrix
) &
)
material_EulerAngles(1:3,c,i,e) = texture_Gauss(1:3,material_texture(c,i,e))
enddo
enddo
enddo
deallocate(texture_transformation)
call config_deallocate('material.config/microstructure')
deallocate(microstructure_phase)
deallocate(microstructure_texture)
end subroutine material_populateGrains

11
src/math.f90
View File

@ -8,7 +8,9 @@
module math
use prec
use future
use IO
use debug
use numerics
implicit none
public
#if __INTEL_COMPILER >= 1900
@ -91,8 +93,6 @@ contains
!> @brief initialization of random seed generator and internal checks
!--------------------------------------------------------------------------------------------------
subroutine math_init
use numerics, only: &
randomSeed
integer :: i
real(pReal), dimension(4) :: randTest
@ -133,7 +133,6 @@ end subroutine math_init
!> @brief check correctness of (some) math functions
!--------------------------------------------------------------------------------------------------
subroutine unitTest
use IO, only: IO_error
character(len=64) :: error_msg
@ -526,8 +525,6 @@ end subroutine math_invert33
!> @brief Inversion of symmetriced 3x3x3x3 tensor.
!--------------------------------------------------------------------------------------------------
function math_invSym3333(A)
use IO, only: &
IO_error
real(pReal),dimension(3,3,3,3) :: math_invSym3333
@ -1443,8 +1440,6 @@ end function math_eigenvectorBasisSym33_log
!> @brief rotational part from polar decomposition of 33 tensor m
!--------------------------------------------------------------------------------------------------
function math_rotationalPart33(m)
use IO, only: &
IO_warning
real(pReal), intent(in), dimension(3,3) :: m
real(pReal), dimension(3,3) :: math_rotationalPart33

194
src/mesh/DAMASK_FEM.f90
View File

@ -9,65 +9,31 @@
program DAMASK_FEM
#include <petsc/finclude/petscsys.h>
use PetscDM
use prec, only: &
pInt, &
pReal, &
tol_math_check
use DAMASK_interface, only: &
DAMASK_interface_init, &
loadCaseFile, &
getSolverJobName
use IO, only: &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_error, &
IO_lc, &
IO_intOut, &
IO_warning
use math ! need to include the whole module for FFTW
use prec
use DAMASK_interface
use IO
use math
use CPFEM2
use FEsolving, only: &
restartWrite, &
restartInc
use numerics, only: &
worldrank, &
maxCutBack, &
stagItMax
use mesh, only: &
mesh_Nboundaries, &
mesh_boundaries, &
geomMesh
use FEM_Utilities, only: &
utilities_init, &
tSolutionState, &
tLoadCase, &
cutBack, &
maxFields, &
nActiveFields, &
FIELD_MECH_ID, &
COMPONENT_MECH_X_ID, &
COMPONENT_MECH_Y_ID, &
COMPONENT_MECH_Z_ID, &
FIELD_MECH_label
use FEsolving
use numerics
use mesh
use FEM_Utilities
use FEM_mech
implicit none
!--------------------------------------------------------------------------------------------------
! variables related to information from load case and geom file
integer(pInt), allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing
integer(pInt) :: &
N_def = 0_pInt !< # of rate of deformation specifiers found in load case file
integer, allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing
integer :: &
N_def = 0 !< # of rate of deformation specifiers found in load case file
character(len=65536) :: &
line
!--------------------------------------------------------------------------------------------------
! loop variables, convergence etc.
integer(pInt), parameter :: &
subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0
integer, parameter :: &
subStepFactor = 2 !< 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
@ -77,22 +43,22 @@ program DAMASK_FEM
logical :: &
guess, & !< guess along former trajectory
stagIterate
integer(pInt) :: &
integer :: &
i, &
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
currentFace = 0_pInt, &
cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0 !< fraction of current time interval
integer :: &
currentLoadcase = 0, & !< current load case
currentFace = 0, &
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
fileUnit = 0_pInt, & !< file unit for reading load case and writing results
totalIncsCounter = 0, & !< total # of increments
convergedCounter = 0, & !< # of converged increments
notConvergedCounter = 0, & !< # of non-converged increments
fileUnit = 0, & !< file unit for reading load case and writing results
myStat, &
statUnit = 0_pInt, & !< file unit for statistics output
lastRestartWritten = 0_pInt, & !< total increment No. at which last restart information was written
statUnit = 0, & !< file unit for statistics output
lastRestartWritten = 0, & !< total increment No. at which last restart information was written
stagIter, &
component
character(len=6) :: loadcase_string
@ -120,17 +86,17 @@ program DAMASK_FEM
!--------------------------------------------------------------------------------------------------
! reading basic information from load case file and allocate data structure containing load cases
open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile))
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=trim(loadCaseFile))
do
read(fileUnit, '(A)', iostat=myStat) line
if ( myStat /= 0_pInt) exit
if ( myStat /= 0) exit
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase
do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('$loadcase')
N_def = N_def + 1_pInt
N_def = N_def + 1
end select
enddo ! count all identifiers to allocate memory and do sanity check
enddo
@ -172,35 +138,35 @@ program DAMASK_FEM
rewind(fileUnit)
do
read(fileUnit, '(A)', iostat=myStat) line
if ( myStat /= 0_pInt) exit
if ( myStat /= 0) exit
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1)
do i = 1, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
!--------------------------------------------------------------------------------------------------
! loadcase information
case('$loadcase')
currentLoadCase = IO_intValue(line,chunkPos,i+1_pInt)
currentLoadCase = IO_intValue(line,chunkPos,i+1)
case('face')
currentFace = IO_intValue(line,chunkPos,i+1_pInt)
currentFaceSet = -1_pInt
currentFace = IO_intValue(line,chunkPos,i+1)
currentFaceSet = -1
do faceSet = 1, mesh_Nboundaries
if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
enddo
if (currentFaceSet < 0_pInt) call IO_error(error_ID = errorID, ext_msg = 'invalid BC')
if (currentFaceSet < 0) call IO_error(error_ID = errorID, ext_msg = 'invalid BC')
case('t','time','delta') ! increment time
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt)
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1)
case('n','incs','increments','steps') ! number of increments
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
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
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
loadCases(currentLoadCase)%logscale = 1
case('freq','frequency','outputfreq') ! frequency of result writings
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1)
case('r','restart','restartwrite') ! frequency of writing restart information
loadCases(currentLoadCase)%restartfrequency = &
max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt))
max(0,IO_intValue(line,chunkPos,i+1))
case('guessreset','dropguessing')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
@ -214,7 +180,7 @@ program DAMASK_FEM
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
IO_floatValue(line,chunkPos,i+1)
endif
enddo
endif
@ -227,7 +193,7 @@ program DAMASK_FEM
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
IO_floatValue(line,chunkPos,i+1)
endif
enddo
endif
@ -240,7 +206,7 @@ program DAMASK_FEM
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
IO_floatValue(line,chunkPos,i+1)
endif
enddo
endif
@ -252,20 +218,20 @@ program DAMASK_FEM
!--------------------------------------------------------------------------------------------------
! consistency checks and output of load case
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
errorID = 0_pInt
checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases)
errorID = 0
checkLoadcases: do currentLoadCase = 1, 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'
do field = 1_pInt, nActiveFields
do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
end select
do faceSet = 1_pInt, mesh_Nboundaries
do component = 1_pInt, loadCases(currentLoadCase)%fieldBC(field)%nComponents
do faceSet = 1, mesh_Nboundaries
do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
' Component ', component, &
@ -275,19 +241,19 @@ program DAMASK_FEM
enddo
enddo
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! 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
if (loadCases(currentLoadCase)%outputfrequency < 1) errorID = 836 ! 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
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
enddo checkLoadcases
!--------------------------------------------------------------------------------------------------
! doing initialization depending on active solvers
call Utilities_init()
call Utilities_init
do field = 1, nActiveFields
select case (loadCases(1)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
@ -296,30 +262,30 @@ program DAMASK_FEM
enddo
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
loadCaseLooping: do currentLoadCase = 1, size(loadCases)
time0 = time ! load case start time
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1_pInt
incLooping: do inc = 1, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1
!--------------------------------------------------------------------------------------------------
! forwarding time
timeIncOld = timeinc ! last timeinc that brought former inc to an end
if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale
if (loadCases(currentLoadCase)%logscale == 0) then ! linear scale
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
else
if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale
if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
if (currentLoadCase == 1) then ! 1st load case of logarithmic scale
if (inc == 1) then ! 1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
else ! not-1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal))
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal))
endif
else ! not-1st load case 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)/&
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1 ,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal)))
endif
endif
@ -327,14 +293,14 @@ program DAMASK_FEM
skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc?
time = time + timeinc ! just advance time, skip already performed calculation
guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference
guess = .true.
else skipping
stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
time = time + timeinc ! forward target time
stepFraction = stepFraction + 1_pInt ! count step
stepFraction = stepFraction + 1 ! count step
!--------------------------------------------------------------------------------------------------
! report begin of new step
@ -369,7 +335,7 @@ program DAMASK_FEM
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 0_pInt
stagIter = 0
stagIterate = .true.
do while (stagIterate)
do field = 1, nActiveFields
@ -383,7 +349,7 @@ program DAMASK_FEM
if(.not. solres(field)%converged) exit ! no solution found
enddo
stagIter = stagIter + 1_pInt
stagIter = stagIter + 1
stagIterate = stagIter < stagItMax &
.and. all(solres(:)%converged) &
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
@ -395,13 +361,13 @@ program DAMASK_FEM
if (cutBackLevel < maxCutBack) then ! do cut back
write(6,'(/,a)') ' cut back detected'
cutBack = .True.
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1_pInt
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1
time = time - timeinc ! rewind time
timeinc = timeinc/2.0_pReal
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
call IO_warning(850)
call quit(-1*(lastRestartWritten+1)) ! quit and provide information about last restart inc written
endif
else
guess = .true. ! start guessing after first converged (sub)inc
@ -413,26 +379,26 @@ program DAMASK_FEM
endif
enddo subStepLooping
cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc
cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc
if (all(solres(:)%converged)) then
convergedCounter = convergedCounter + 1_pInt
convergedCounter = convergedCounter + 1
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc
' increment ', totalIncsCounter, ' converged'
else
notConvergedCounter = notConvergedCounter + 1_pInt
notConvergedCounter = notConvergedCounter + 1
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
' increment ', totalIncsCounter, ' NOT converged'
endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency
write(6,'(1/,a)') ' ... writing results to file ......................................'
call CPFEM_results(totalIncsCounter,time)
endif
if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ...
.and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information
if ( loadCases(currentLoadCase)%restartFrequency > 0 & ! writing of restart info requested ...
.and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! ... and at frequency of writing restart information
restartWrite = .true. ! set restart parameter for FEsolving
lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write?
lastRestartWritten = inc ! first call to CPFEM_general will write
endif
endif skipping
@ -453,7 +419,7 @@ program DAMASK_FEM
flush(6)
close(statUnit)
if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged
call quit(0_pInt) ! no complains ;)
if (notConvergedCounter > 0) call quit(2) ! error if some are not converged
call quit(0) ! no complains ;)
end program DAMASK_FEM

106
src/mesh/FEM_mech.f90
View File

@ -13,15 +13,17 @@ module FEM_mech
use PETScDM
use PETScDMplex
use PETScDT
use prec, only: &
pReal
use FEM_utilities, only: &
tSolutionState, &
tFieldBC, &
tComponentBC
use mesh, only: &
mesh_Nboundaries, &
mesh_boundaries
use prec
use FEM_utilities
use mesh
use IO
use DAMASK_interface
use numerics
use FEM_Zoo
use FEsolving
use homogenization
use math
implicit none
private
@ -34,49 +36,36 @@ module FEM_mech
real(pReal) :: timeincOld
end type tSolutionParams
type(tSolutionParams), private :: params
type(tSolutionParams) :: params
!--------------------------------------------------------------------------------------------------
! PETSc data
SNES, private :: mech_snes
Vec, private :: solution, solution_rate, solution_local
PetscInt, private :: dimPlex, cellDof, nQuadrature, nBasis
PetscReal, allocatable, target, private :: qPoints(:), qWeights(:)
MatNullSpace, private :: matnull
SNES :: mech_snes
Vec :: solution, solution_rate, solution_local
PetscInt :: dimPlex, cellDof, nQuadrature, nBasis
PetscReal, allocatable, target :: qPoints(:), qWeights(:)
MatNullSpace :: matnull
!--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc.
character(len=1024), private :: incInfo
real(pReal), private, dimension(3,3) :: &
character(len=1024) :: incInfo
real(pReal), dimension(3,3) :: &
P_av = 0.0_pReal
logical, private :: ForwardData
real(pReal), parameter, private :: eps = 1.0e-18_pReal
logical :: ForwardData
real(pReal), parameter :: eps = 1.0e-18_pReal
public :: &
FEM_mech_init, &
FEM_mech_solution, &
FEM_mech_forward
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_init(fieldBC)
use IO, only: &
IO_error
use DAMASK_interface, only: &
getSolverJobName
use mesh, only: &
geomMesh
use numerics, only: &
itmax, &
integrationOrder
use FEM_Zoo, only: &
FEM_Zoo_nQuadrature, &
FEM_Zoo_QuadraturePoints, &
FEM_Zoo_QuadratureWeights
implicit none
type(tFieldBC), intent(in) :: fieldBC
DM :: mech_mesh
PetscFE :: mechFE
@ -99,7 +88,7 @@ subroutine FEM_mech_init(fieldBC)
PetscReal, allocatable, target :: cellJMat(:,:)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscInt :: cellStart, cellEnd, cell, basis
character(len=7) :: prefix = 'mechFE_'
character(len=7), parameter :: prefix = 'mechFE_'
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>'
@ -246,12 +235,7 @@ end subroutine FEM_mech_init
!--------------------------------------------------------------------------------------------------
type(tSolutionState) function FEM_mech_solution( &
incInfoIn,timeinc,timeinc_old,fieldBC)
use numerics, only: &
itmax
use FEsolving, only: &
terminallyIll
implicit none
!--------------------------------------------------------------------------------------------------
! input data for solution
real(pReal), intent(in) :: &
@ -263,7 +247,6 @@ type(tSolutionState) function FEM_mech_solution( &
incInfoIn
!--------------------------------------------------------------------------------------------------
!
PetscErrorCode :: ierr
SNESConvergedReason :: reason
@ -298,21 +281,7 @@ end function FEM_mech_solution
!> @brief forms the FEM residual vector
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
use numerics, only: &
BBarStabilisation
use FEM_utilities, only: &
utilities_projectBCValues, &
utilities_constitutiveResponse
use homogenization, only: &
materialpoint_F, &
materialpoint_P
use math, only: &
math_det33, &
math_inv33
use FEsolving, only: &
terminallyIll
implicit none
DM :: dm_local
PetscDS :: prob
Vec :: x_local, f_local, xx_local
@ -433,19 +402,6 @@ end subroutine FEM_mech_formResidual
!> @brief forms the FEM stiffness matrix
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
use numerics, only: &
BBarStabilisation
use homogenization, only: &
materialpoint_dPdF, &
materialpoint_F
use math, only: &
math_inv33, &
math_identity2nd, &
math_det33
use FEM_utilities, only: &
utilities_projectBCValues
implicit none
DM :: dm_local
PetscDS :: prob
@ -577,15 +533,7 @@ end subroutine FEM_mech_formJacobian
!> @brief forwarding routine
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_forward(guess,timeinc,timeinc_old,fieldBC)
use FEM_utilities, only: &
cutBack
use homogenization, only: &
materialpoint_F0, &
materialpoint_F
use FEM_utilities, only: &
utilities_projectBCValues
implicit none
type(tFieldBC), intent(in) :: &
fieldBC
real(pReal), intent(in) :: &
@ -644,15 +592,7 @@ end subroutine FEM_mech_forward
!> @brief reporting
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr)
use numerics, only: &
err_struct_tolAbs, &
err_struct_tolRel
use IO, only: &
IO_intOut
use FEsolving, only: &
terminallyIll
implicit none
SNES :: snes_local
PetscInt :: PETScIter
PetscReal :: xnorm,snorm,fnorm,divTol

49
src/mesh/FEM_utilities.f90
View File

@ -6,19 +6,26 @@ module FEM_utilities
#include <petsc/finclude/petscdmplex.h>
#include <petsc/finclude/petscdmda.h>
#include <petsc/finclude/petscis.h>
use prec, only: pReal, pInt
use PETScdmplex
use PETScdmda
use PETScis
use prec
use FEsolving
use homogenization
use numerics
use debug
use math
use mesh
implicit none
private
!--------------------------------------------------------------------------------------------------
!
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
integer(pInt), public, parameter :: maxFields = 6_pInt
integer(pInt), public :: nActiveFields = 0_pInt
integer, public, parameter :: maxFields = 6
integer, public :: nActiveFields = 0
!--------------------------------------------------------------------------------------------------
! grid related information information
@ -43,7 +50,7 @@ use PETScis
!--------------------------------------------------------------------------------------------------
! variables controlling debugging
logical, private :: &
logical :: &
debugPETSc !< use some in debug defined options for more verbose PETSc solution
!--------------------------------------------------------------------------------------------------
@ -51,7 +58,7 @@ use PETScis
type, public :: tSolutionState !< return type of solution from FEM solver variants
logical :: converged = .true.
logical :: stagConverged = .true.
integer(pInt) :: iterationsNeeded = 0_pInt
integer :: iterationsNeeded = 0
end type tSolutionState
type, public :: tComponentBC
@ -62,18 +69,18 @@ use PETScis
type, public :: tFieldBC
integer(kind(FIELD_UNDEFINED_ID)) :: ID
integer(pInt) :: nComponents = 0_pInt
integer :: nComponents = 0
type(tComponentBC), allocatable :: componentBC(:)
end type tFieldBC
type, public :: tLoadCase
real(pReal) :: time = 0.0_pReal !< length of increment
integer(pInt) :: incs = 0_pInt, & !< number of increments
outputfrequency = 1_pInt, & !< frequency of result writes
restartfrequency = 0_pInt, & !< frequency of restart writes
logscale = 0_pInt !< linear/logarithmic time inc flag
integer :: incs = 0, & !< number of increments
outputfrequency = 1, & !< frequency of result writes
restartfrequency = 0, & !< frequency of restart writes
logscale = 0 !< linear/logarithmic time inc flag
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
integer(pInt), allocatable :: faceID(:)
integer, allocatable :: faceID(:)
type(tFieldBC), allocatable :: fieldBC(:)
end type tLoadCase
@ -92,19 +99,6 @@ contains
!> @brief allocates all neccessary fields, sets debug flags
!--------------------------------------------------------------------------------------------------
subroutine utilities_init
use numerics, only: &
structOrder, &
petsc_defaultOptions, &
petsc_options
use debug, only: &
debug_level, &
debug_SPECTRAL, &
debug_SPECTRALPETSC,&
PETSCDEBUG
use math ! must use the whole module for use of FFTW
use mesh, only: &
mesh_NcpElemsGlobal, &
mesh_maxNips
character(len=1024) :: petsc_optionsPhysics
PetscErrorCode :: ierr
@ -139,11 +133,6 @@ end subroutine utilities_init
!> @brief calculates constitutive response
!--------------------------------------------------------------------------------------------------
subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
use FEsolving, only: &
restartWrite
use homogenization, only: &
materialpoint_P, &
materialpoint_stressAndItsTangent
real(pReal), intent(in) :: timeinc !< loading time
logical, intent(in) :: forwardData !< age results

255
src/mesh/FEM_zoo.f90
View File

@ -3,24 +3,26 @@
!> @brief Interpolation data used by the FEM solver
!--------------------------------------------------------------------------------------------------
module FEM_Zoo
use prec, only: pReal, pInt, group_float
use prec
implicit none
private
integer(pInt), parameter, public:: &
integer, parameter :: &
maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary)
real(pReal), dimension(2,3), private, parameter :: &
real(pReal), dimension(2,3), parameter :: &
triangle = reshape([-1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, &
-1.0_pReal, 1.0_pReal], shape=[2,3])
real(pReal), dimension(3,4), private, parameter :: &
real(pReal), dimension(3,4), parameter :: &
tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, -1.0_pReal, &
-1.0_pReal, 1.0_pReal, -1.0_pReal, &
-1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4])
integer(pInt), dimension(3,maxOrder), public, protected :: &
FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(1-3) and interpolation order(1-maxOrder)
type(group_float), dimension(3,maxOrder), public, protected :: &
integer, dimension(2:3,maxOrder), public, protected :: &
FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(2-3) and interpolation order(1-maxOrder)
type(group_float), dimension(2:3,maxOrder), public, protected :: &
FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule
FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule
@ -34,236 +36,251 @@ contains
!> @brief initializes FEM interpolation data
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_init
implicit none
write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>'
!--------------------------------------------------------------------------------------------------
! 2D linear
FEM_Zoo_nQuadrature(2,1) = 1
allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1))
allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2))
FEM_Zoo_QuadratureWeights(2,1)%p(1) = 1.0_pReal
call FEM_Zoo_permutationStar3([1.0_pReal/3.0_pReal], &
FEM_Zoo_QuadraturePoints(2,1)%p(1:2))
allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2))
FEM_Zoo_QuadraturePoints (2,1)%p(1:2) = FEM_Zoo_permutationStar3([1.0_pReal/3.0_pReal])
!--------------------------------------------------------------------------------------------------
! 2D quadratic
FEM_Zoo_nQuadrature(2,2) = 3
allocate(FEM_Zoo_QuadratureWeights(2,2)%p(3))
allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6))
FEM_Zoo_QuadratureWeights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal
call FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal], &
FEM_Zoo_QuadraturePoints(2,2)%p(1:6))
allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6))
FEM_Zoo_QuadraturePoints (2,2)%p(1:6) = FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal])
!--------------------------------------------------------------------------------------------------
! 2D cubic
FEM_Zoo_nQuadrature(2,3) = 6
allocate(FEM_Zoo_QuadratureWeights(2,3)%p(6))
allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12))
FEM_Zoo_QuadratureWeights(2,3)%p(1:3) = 0.22338158967801146570_pReal
call FEM_Zoo_permutationStar21([0.44594849091596488632_pReal], &
FEM_Zoo_QuadraturePoints(2,3)%p(1:6))
FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal
call FEM_Zoo_permutationStar21([0.091576213509770743460_pReal], &
FEM_Zoo_QuadraturePoints(2,3)%p(7:12))
allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12))
FEM_Zoo_QuadraturePoints (2,3)%p(1:6) = FEM_Zoo_permutationStar21([0.44594849091596488632_pReal])
FEM_Zoo_QuadraturePoints (2,3)%p(7:12)= FEM_Zoo_permutationStar21([0.091576213509770743460_pReal])
!--------------------------------------------------------------------------------------------------
! 2D quartic
FEM_Zoo_nQuadrature(2,4) = 12
allocate(FEM_Zoo_QuadratureWeights(2,4)%p(12))
allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24))
FEM_Zoo_QuadratureWeights(2,4)%p(1:3) = 0.11678627572638_pReal
call FEM_Zoo_permutationStar21([0.24928674517091_pReal], &
FEM_Zoo_QuadraturePoints(2,4)%p(1:6))
FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal
call FEM_Zoo_permutationStar21([0.06308901449150_pReal], &
FEM_Zoo_QuadraturePoints(2,4)%p(7:12))
FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal
call FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal], &
FEM_Zoo_QuadraturePoints(2,4)%p(13:24))
allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24))
FEM_Zoo_QuadraturePoints (2,4)%p(1:6) = FEM_Zoo_permutationStar21([0.24928674517091_pReal])
FEM_Zoo_QuadraturePoints (2,4)%p(7:12) = FEM_Zoo_permutationStar21([0.06308901449150_pReal])
FEM_Zoo_QuadraturePoints (2,4)%p(13:24)= FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal])
!--------------------------------------------------------------------------------------------------
! 2D order 5
FEM_Zoo_nQuadrature(2,5) = 16
allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16))
allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32))
FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal
call FEM_Zoo_permutationStar3([0.33333333333333_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(1:2))
FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal
call FEM_Zoo_permutationStar21([0.45929258829272_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(3:8))
FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal
call FEM_Zoo_permutationStar21([0.17056930775176_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(9:14))
FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal
call FEM_Zoo_permutationStar21([0.05054722831703_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(15:20))
FEM_Zoo_QuadratureWeights(2,5)%p(11:16)= 0.02723031417443_pReal
call FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(21:32))
allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32))
FEM_Zoo_QuadraturePoints (2,5)%p(1:2) = FEM_Zoo_permutationStar3([0.33333333333333_pReal])
FEM_Zoo_QuadraturePoints (2,5)%p(3:8) = FEM_Zoo_permutationStar21([0.45929258829272_pReal])
FEM_Zoo_QuadraturePoints (2,5)%p(9:14) = FEM_Zoo_permutationStar21([0.17056930775176_pReal])
FEM_Zoo_QuadraturePoints (2,5)%p(15:20)= FEM_Zoo_permutationStar21([0.05054722831703_pReal])
FEM_Zoo_QuadraturePoints (2,5)%p(21:32)=FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal])
!--------------------------------------------------------------------------------------------------
! 3D linear
FEM_Zoo_nQuadrature(3,1) = 1
allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1))
allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3))
FEM_Zoo_QuadratureWeights(3,1)%p(1) = 1.0_pReal
call FEM_Zoo_permutationStar4([0.25_pReal], &
FEM_Zoo_QuadraturePoints(3,1)%p(1:3))
allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3))
FEM_Zoo_QuadraturePoints (3,1)%p(1:3)= FEM_Zoo_permutationStar4([0.25_pReal])
!--------------------------------------------------------------------------------------------------
! 3D quadratic
FEM_Zoo_nQuadrature(3,2) = 4
allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4))
allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12))
FEM_Zoo_QuadratureWeights(3,2)%p(1:4) = 0.25_pReal
call FEM_Zoo_permutationStar31([0.13819660112501051518_pReal], &
FEM_Zoo_QuadraturePoints(3,2)%p(1:12))
allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12))
FEM_Zoo_QuadraturePoints (3,2)%p(1:12)= FEM_Zoo_permutationStar31([0.13819660112501051518_pReal])
!--------------------------------------------------------------------------------------------------
! 3D cubic
FEM_Zoo_nQuadrature(3,3) = 14
allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14))
allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42))
FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal
call FEM_Zoo_permutationStar31([0.092735250310891226402_pReal], &
FEM_Zoo_QuadraturePoints(3,3)%p(1:12))
FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal
call FEM_Zoo_permutationStar31([0.31088591926330060980_pReal], &
FEM_Zoo_QuadraturePoints(3,3)%p(13:24))
FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal
FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal
call FEM_Zoo_permutationStar22([0.045503704125649649492_pReal], &
FEM_Zoo_QuadraturePoints(3,3)%p(25:42))
allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42))
FEM_Zoo_QuadraturePoints (3,3)%p(1:12) = FEM_Zoo_permutationStar31([0.092735250310891226402_pReal])
FEM_Zoo_QuadraturePoints (3,3)%p(13:24)= FEM_Zoo_permutationStar31([0.31088591926330060980_pReal])
FEM_Zoo_QuadraturePoints (3,3)%p(25:42)= FEM_Zoo_permutationStar22([0.045503704125649649492_pReal])
!--------------------------------------------------------------------------------------------------
! 3D quartic
FEM_Zoo_nQuadrature(3,4) = 35
allocate(FEM_Zoo_QuadratureWeights(3,4)%p(35))
allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105))
FEM_Zoo_QuadratureWeights(3,4)%p(1:4) = 0.0021900463965388_pReal
call FEM_Zoo_permutationStar31([0.0267367755543735_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(1:12))
FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal
call FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(13:48))
FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal
call FEM_Zoo_permutationStar22([0.4547545999844830_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(49:66))
FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal
call FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(67:102))
FEM_Zoo_QuadratureWeights(3,4)%p(35) = 0.0931745731195340_pReal
call FEM_Zoo_permutationStar4([0.25_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(103:105))
allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105))
FEM_Zoo_QuadraturePoints (3,4)%p(1:12) = FEM_Zoo_permutationStar31([0.0267367755543735_pReal])
FEM_Zoo_QuadraturePoints (3,4)%p(13:48) = FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal])
FEM_Zoo_QuadraturePoints (3,4)%p(49:66) = FEM_Zoo_permutationStar22([0.4547545999844830_pReal])
FEM_Zoo_QuadraturePoints (3,4)%p(67:102) = FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal])
FEM_Zoo_QuadraturePoints (3,4)%p(103:105)= FEM_Zoo_permutationStar4([0.25_pReal])
!--------------------------------------------------------------------------------------------------
! 3D quintic
FEM_Zoo_nQuadrature(3,5) = 56
allocate(FEM_Zoo_QuadratureWeights(3,5)%p(56))
allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168))
FEM_Zoo_QuadratureWeights(3,5)%p(1:4) = 0.0010373112336140_pReal
call FEM_Zoo_permutationStar31([0.0149520651530592_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(1:12))
FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal
call FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(13:48))
FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal
call FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(49:84))
FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal
call FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(85:120))
FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal
call FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(121:156))
FEM_Zoo_QuadratureWeights(3,5)%p(53:56) = 0.0366291366405108_pReal
call FEM_Zoo_permutationStar31([0.1344783347929940_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(157:168))
allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168))
FEM_Zoo_QuadraturePoints (3,5)%p(1:12) = FEM_Zoo_permutationStar31([0.0149520651530592_pReal])
FEM_Zoo_QuadraturePoints (3,5)%p(13:48) = FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal])
FEM_Zoo_QuadraturePoints (3,5)%p(49:84) = FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal])
FEM_Zoo_QuadraturePoints (3,5)%p(85:120) = FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal])
FEM_Zoo_QuadraturePoints (3,5)%p(121:156)= FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal])
FEM_Zoo_QuadraturePoints (3,5)%p(157:168)= FEM_Zoo_permutationStar31([0.1344783347929940_pReal])
end subroutine FEM_Zoo_init
!--------------------------------------------------------------------------------------------------
!> @brief star 3 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar3(point,qPt)
pure function FEM_Zoo_permutationStar3(point) result(qPt)
implicit none
real(pReal) :: point(1), qPt(2,1), temp(3,1)
real(pReal), dimension(2) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(3,1) :: temp
temp(:,1) = [point(1), point(1), point(1)]
qPt = matmul(triangle, temp)
end subroutine FEM_Zoo_permutationStar3
qPt = reshape(matmul(triangle, temp),[2])
end function FEM_Zoo_permutationStar3
!--------------------------------------------------------------------------------------------------
!> @brief star 21 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar21(point,qPt)
pure function FEM_Zoo_permutationStar21(point) result(qPt)
implicit none
real(pReal) :: point(1), qPt(2,3), temp(3,3)
real(pReal), dimension(6) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(3,3) :: temp
temp(:,1) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1)]
temp(:,2) = [point(1), 1.0_pReal - 2.0_pReal*point(1), point(1)]
temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)]
qPt = matmul(triangle, temp)
end subroutine FEM_Zoo_permutationStar21
qPt = reshape(matmul(triangle, temp),[6])
end function FEM_Zoo_permutationStar21
!--------------------------------------------------------------------------------------------------
!> @brief star 111 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar111(point,qPt)
pure function FEM_Zoo_permutationStar111(point) result(qPt)
implicit none
real(pReal) :: point(2), qPt(2,6), temp(3,6)
real(pReal), dimension(12) :: qPt
real(pReal), dimension(2), intent(in) :: point
real(pReal), dimension(3,6) :: temp
temp(:,1) = [point(1), point(2), 1.0_pReal - point(1) - point(2)]
temp(:,2) = [point(1), 1.0_pReal - point(1) - point(2), point(2)]
temp(:,4) = [point(2), 1.0_pReal - point(1) - point(2), point(1)]
temp(:,5) = [1.0_pReal - point(1) - point(2), point(2), point(1)]
temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)]
qPt = matmul(triangle, temp)
end subroutine FEM_Zoo_permutationStar111
qPt = reshape(matmul(triangle, temp),[12])
end function FEM_Zoo_permutationStar111
!--------------------------------------------------------------------------------------------------
!> @brief star 4 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar4(point,qPt)
pure function FEM_Zoo_permutationStar4(point) result(qPt)
implicit none
real(pReal) :: point(1), qPt(3,1), temp(4,1)
real(pReal), dimension(3) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(4,1) :: temp
temp(:,1) = [point(1), point(1), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar4
qPt = reshape(matmul(tetrahedron, temp),[3])
end function FEM_Zoo_permutationStar4
!--------------------------------------------------------------------------------------------------
!> @brief star 31 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar31(point,qPt)
pure function FEM_Zoo_permutationStar31(point) result(qPt)
implicit none
real(pReal) :: point(1), qPt(3,4), temp(4,4)
real(pReal), dimension(12) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(4,4) :: temp
temp(:,1) = [point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1)]
temp(:,2) = [point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1)]
temp(:,3) = [point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1)]
temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar31
qPt = reshape(matmul(tetrahedron, temp),[12])
end function FEM_Zoo_permutationStar31
!--------------------------------------------------------------------------------------------------
!> @brief star 22 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar22(point,qPt)
pure function FEM_Zoo_permutationStar22(point) result(qPt)
implicit none
real(pReal) :: point(1), qPt(3,6), temp(4,6)
real(pReal), dimension(18) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(4,6) :: temp
temp(:,1) = [point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1)]
temp(:,2) = [point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1)]
@ -271,17 +288,21 @@ subroutine FEM_Zoo_permutationStar22(point,qPt)
temp(:,4) = [0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1)]
temp(:,5) = [0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1)]
temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar22
qPt = reshape(matmul(tetrahedron, temp),[18])
end function FEM_Zoo_permutationStar22
!--------------------------------------------------------------------------------------------------
!> @brief star 211 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar211(point,qPt)
pure function FEM_Zoo_permutationStar211(point) result(qPt)
implicit none
real(pReal) :: point(2), qPt(3,12), temp(4,12)
real(pReal), dimension(36) :: qPt
real(pReal), dimension(2), intent(in) :: point
real(pReal), dimension(4,12) :: temp
temp(:,1 ) = [point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
temp(:,2 ) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2)]
@ -295,17 +316,21 @@ subroutine FEM_Zoo_permutationStar211(point,qPt)
temp(:,10) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2)]
temp(:,11) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1)]
temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar211
qPt = reshape(matmul(tetrahedron, temp),[36])
end function FEM_Zoo_permutationStar211
!--------------------------------------------------------------------------------------------------
!> @brief star 1111 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar1111(point,qPt)
pure function FEM_Zoo_permutationStar1111(point) result(qPt)
implicit none
real(pReal) :: point(3), qPt(3,24), temp(4,24)
real(pReal), dimension(72) :: qPt
real(pReal), dimension(3), intent(in) :: point
real(pReal), dimension(4,24) :: temp
temp(:,1 ) = [point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3)]
temp(:,2 ) = [point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3)]
@ -331,9 +356,9 @@ subroutine FEM_Zoo_permutationStar1111(point,qPt)
temp(:,22) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1)]
temp(:,23) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2)]
temp(:,24) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar1111
qPt = reshape(matmul(tetrahedron, temp),[72])
end function FEM_Zoo_permutationStar1111
end module FEM_Zoo

137
src/mesh_FEM.f90
View File

@ -3,37 +3,39 @@
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Driver controlling inner and outer load case looping of the FEM solver
!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing
!> results
!--------------------------------------------------------------------------------------------------
module mesh
#include <petsc/finclude/petscdmplex.h>
#include <petsc/finclude/petscis.h>
#include <petsc/finclude/petscdmda.h>
use prec, only: pReal, pInt
use prec
use mesh_base
use PETScdmplex
use PETScdmda
use PETScis
use DAMASK_interface
use IO
use debug
use discretization
use numerics
use FEsolving
use FEM_Zoo
implicit none
private
integer(pInt), public, parameter :: &
mesh_ElemType=1_pInt !< Element type of the mesh (only support homogeneous meshes)
integer(pInt), public, protected :: &
integer, public, protected :: &
mesh_Nboundaries, &
mesh_NcpElems, & !< total number of CP elements in mesh
mesh_NcpElemsGlobal, &
mesh_Nnodes, & !< total number of nodes in mesh
mesh_maxNipNeighbors
mesh_Nnodes !< total number of nodes in mesh
!!!! BEGIN DEPRECATED !!!!!
integer(pInt), public, protected :: &
integer, public, protected :: &
mesh_maxNips !< max number of IPs in any CP element
!!!! BEGIN DEPRECATED !!!!!
integer(pInt), dimension(:,:), allocatable, public, protected :: &
integer, dimension(:,:), allocatable, public, protected :: &
mesh_element !DEPRECATED
real(pReal), dimension(:,:), allocatable, public :: &
@ -46,35 +48,12 @@ use PETScis
real(pReal), dimension(:,:,:), allocatable, public :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
mesh_ipArea !< area of interface to neighboring IP (initially!)
real(pReal),dimension(:,:,:,:), allocatable, public, protected :: &
mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!)
integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: &
mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes)
DM, public :: geomMesh
PetscInt, dimension(:), allocatable, public, protected :: &
mesh_boundaries
integer(pInt), dimension(1_pInt), parameter, public :: FE_geomtype = & !< geometry type of particular element type
int([1],pInt)
integer(pInt), dimension(1_pInt), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type
int([1],pInt)
integer(pInt), dimension(1_pInt), public :: FE_Nips = & !< number of IPs in a specific type of element
int([0],pInt)
integer(pInt), dimension(1_pInt), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type
int([6],pInt)
type, public, extends(tMesh) :: tMesh_FEM
@ -96,18 +75,17 @@ contains
subroutine tMesh_FEM_init(self,dimen,order,nodes)
implicit none
integer, intent(in) :: dimen
integer(pInt), intent(in) :: order
integer, intent(in) :: order
real(pReal), intent(in), dimension(:,:) :: nodes
class(tMesh_FEM) :: self
if (dimen == 2_pInt) then
if (order == 1_pInt) call self%tMesh%init('mesh',1_pInt,nodes)
if (order == 2_pInt) call self%tMesh%init('mesh',2_pInt,nodes)
elseif(dimen == 3_pInt) then
if (order == 1_pInt) call self%tMesh%init('mesh',6_pInt,nodes)
if (order == 2_pInt) call self%tMesh%init('mesh',8_pInt,nodes)
if (dimen == 2) then
if (order == 1) call self%tMesh%init('mesh',1,nodes)
if (order == 2) call self%tMesh%init('mesh',2,nodes)
elseif(dimen == 3) then
if (order == 1) call self%tMesh%init('mesh',6,nodes)
if (order == 2) call self%tMesh%init('mesh',8,nodes)
endif
end subroutine tMesh_FEM_init
@ -118,35 +96,19 @@ subroutine tMesh_FEM_init(self,dimen,order,nodes)
!> @brief initializes the mesh by calling all necessary private routines the mesh module
!! Order and routines strongly depend on type of solver
!--------------------------------------------------------------------------------------------------
subroutine mesh_init()
use DAMASK_interface
use IO, only: &
IO_error, &
IO_open_file, &
IO_stringPos, &
IO_intValue, &
IO_EOF, &
IO_isBlank
use debug, only: &
debug_e, &
debug_i
use numerics, only: &
usePingPong, &
integrationOrder, &
worldrank, &
worldsize
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP
use FEM_Zoo, only: &
FEM_Zoo_nQuadrature, &
FEM_Zoo_QuadraturePoints
subroutine mesh_init
implicit none
integer(pInt), parameter :: FILEUNIT = 222_pInt
integer(pInt) :: j
integer(pInt), allocatable, dimension(:) :: chunkPos
integer, dimension(1), parameter:: FE_geomtype = [1] !< geometry type of particular element type
integer, dimension(1) :: FE_Nips !< number of IPs in a specific type of element
integer, parameter :: FILEUNIT = 222
integer :: j
integer, allocatable, dimension(:) :: chunkPos
integer :: dimPlex
integer, parameter :: &
mesh_ElemType=1 !< Element type of the mesh (only support homogeneous meshes)
character(len=512) :: &
line
logical :: flag
@ -177,7 +139,7 @@ subroutine mesh_init()
call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
allocate(mesh_boundaries(mesh_Nboundaries), source = 0_pInt)
allocate(mesh_boundaries(mesh_Nboundaries), source = 0)
call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr)
CHKERRQ(ierr)
call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr)
@ -230,31 +192,31 @@ subroutine mesh_init()
call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr)
CHKERRQ(ierr)
FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
mesh_maxNips = FE_Nips(1_pInt)
FE_Nips(FE_geomtype(1)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
mesh_maxNips = FE_Nips(1)
write(6,*) 'mesh_maxNips',mesh_maxNips
call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p)
call mesh_FEM_build_ipVolumes(dimPlex)
allocate (mesh_element (4_pInt,mesh_NcpElems)); mesh_element = 0_pInt
allocate (mesh_element (4,mesh_NcpElems)); mesh_element = 0
do j = 1, mesh_NcpElems
mesh_element( 1,j) = -1_pInt ! DEPRECATED
mesh_element( 1,j) = -1 ! DEPRECATED
mesh_element( 2,j) = mesh_elemType ! elem type
mesh_element( 3,j) = 1_pInt ! homogenization
mesh_element( 3,j) = 1 ! homogenization
call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr)
CHKERRQ(ierr)
end do
if (debug_e < 1 .or. debug_e > mesh_NcpElems) &
call IO_error(602_pInt,ext_msg='element') ! selected element does not exist
if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) &
call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP
call IO_error(602,ext_msg='element') ! selected element does not exist
if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2,debug_e)))) &
call IO_error(602,ext_msg='IP') ! selected element does not have requested IP
FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements
FEsolving_execElem = [ 1,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements
if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP)
allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP...
forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element
allocate(FEsolving_execIP(2,mesh_NcpElems)); FEsolving_execIP = 1 ! parallel loop bounds set to comprise from first IP...
forall (j = 1:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element
allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
call theMesh%init(dimplex,integrationOrder,mesh_node0)
@ -263,6 +225,10 @@ subroutine mesh_init()
theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:)
call discretization_init(mesh_element(3,:),mesh_element(4,:),&
reshape(mesh_ipCoordinates,[3,mesh_maxNips*mesh_NcpElems]), &
mesh_node0)
end subroutine mesh_init
@ -271,8 +237,7 @@ end subroutine mesh_init
!--------------------------------------------------------------------------------------------------
pure function mesh_cellCenterCoordinates(ip,el)
implicit none
integer(pInt), intent(in) :: el, & !< element number
integer, intent(in) :: el, & !< element number
ip !< integration point number
real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell
@ -289,11 +254,7 @@ pure function mesh_cellCenterCoordinates(ip,el)
!> and one corner at the central ip.
!--------------------------------------------------------------------------------------------------
subroutine mesh_FEM_build_ipVolumes(dimPlex)
use math, only: &
math_I3, &
math_det33
implicit none
PetscInt :: dimPlex
PetscReal :: vol
PetscReal, target :: cent(dimPlex), norm(dimPlex)
@ -332,9 +293,9 @@ end subroutine mesh_FEM_build_ipVolumes
!--------------------------------------------------------------------------------------------------
subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
implicit none
PetscInt, intent(in) :: dimPlex
PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex)
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscReal :: detJ

13
src/mesh_abaqus.f90
View File

@ -8,9 +8,12 @@
module mesh
use prec
use mesh_base
use geometry_plastic_nonlocal
use discretization
implicit none
private
integer, public, protected :: &
mesh_NcpElems, & !< total number of CP elements in local mesh
mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes)
@ -518,6 +521,14 @@ subroutine mesh_init(ip,el)
theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:)
call discretization_init(mesh_element(3,:),mesh_element(4,:),&
reshape(mesh_ipCoordinates,[3,theMesh%elem%nIPs*theMesh%nElems]),&
mesh_node0)
call geometry_plastic_nonlocal_setIPvolume(mesh_ipVolume)
call geometry_plastic_nonlocal_setIPneighborhood(mesh_ipNeighborhood)
call geometry_plastic_nonlocal_setIParea(mesh_IParea)
call geometry_plastic_nonlocal_setIPareaNormal(mesh_IPareaNormal)
contains
@ -1909,6 +1920,8 @@ subroutine mesh_build_ipNeighborhood
enddo
enddo
call geometry_plastic_nonlocal_set_IPneighborhood(mesh_ipNeighborhood)
contains
!--------------------------------------------------------------------------------------------------
!> @brief find face-matching element of same type

4
src/mesh_base.f90
View File

@ -23,7 +23,7 @@ module mesh_base
elem
real(pReal), dimension(:,:), allocatable, public :: &
ipVolume, & !< volume associated with each IP (initially!)
node0, & !< node x,y,z coordinates (initially)
node_0, & !< node x,y,z coordinates (initially)
node !< node x,y,z coordinates (deformed)
integer(pInt), dimension(:,:), allocatable, public :: &
cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID
@ -62,7 +62,7 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes)
self%type = meshType
call self%elem%init(elemType)
self%node0 = nodes
self%node_0 = nodes
self%nNodes = size(nodes,2)
end subroutine tMesh_base_init

709
src/mesh_grid.f90
View File

@ -1,62 +1,35 @@
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver
!> @brief Parse geometry file to set up discretization and geometry for nonlocal model
!--------------------------------------------------------------------------------------------------
module mesh
use, intrinsic :: iso_c_binding
#include <petsc/finclude/petscsys.h>
use PETScsys
use prec
use system_routines
use DAMASK_interface
use IO
use debug
use numerics
use discretization
use geometry_plastic_nonlocal
use mesh_base
use FEsolving
implicit none
private
integer(pInt), public, protected :: &
mesh_Nnodes
integer(pInt), dimension(:), allocatable, private :: &
microGlobal
integer(pInt), dimension(:), allocatable, private :: &
mesh_homogenizationAt
integer(pInt), dimension(:,:), allocatable, public, protected :: &
mesh_element !< entryCount and list of elements containing node
integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: &
mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
real(pReal), public, protected :: &
mesh_unitlength !< physical length of one unit in mesh
real(pReal), dimension(:,:), allocatable, private :: &
mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!)
real(pReal), dimension(:,:), allocatable, public, protected :: &
mesh_ipVolume, & !< volume associated with IP (initially!)
mesh_node0 !< node x,y,z coordinates (initially!)
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
mesh_ipArea !< area of interface to neighboring IP (initially!)
real(pReal), dimension(:,:,:), allocatable, public :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
real(pReal),dimension(:,:,:,:), allocatable, public, protected :: &
mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!)
logical, dimension(3), public, parameter :: mesh_periodicSurface = .true. !< flag indicating periodic outer surfaces (used for fluxes)
! grid specific
integer(pInt), dimension(3), public, protected :: &
integer, dimension(3), public, protected :: &
grid !< (global) grid
integer(pInt), public, protected :: &
mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh
integer, public, protected :: &
grid3, & !< (local) grid in 3rd direction
grid3Offset !< (local) grid offset in 3rd direction
real(pReal), dimension(3), public, protected :: &
geomSize
real(pReal), public, protected :: &
@ -66,150 +39,79 @@ module mesh
public :: &
mesh_init
private :: &
mesh_build_ipAreas, &
mesh_build_ipNormals, &
mesh_spectral_build_nodes, &
mesh_spectral_build_elements, &
mesh_spectral_build_ipNeighborhood, &
mesh_build_ipCoordinates
type, public, extends(tMesh) :: tMesh_grid
integer(pInt), dimension(3), public :: &
grid !< (global) grid
integer(pInt), public :: &
mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh
grid3, & !< (local) grid in 3rd direction
grid3Offset !< (local) grid offset in 3rd direction
real(pReal), dimension(3), public :: &
geomSize
real(pReal), public :: &
size3, & !< (local) size in 3rd direction
size3offset
contains
procedure, pass(self) :: tMesh_grid_init
generic, public :: init => tMesh_grid_init
end type tMesh_grid
type(tMesh_grid), public, protected :: theMesh
contains
subroutine tMesh_grid_init(self,nodes)
implicit none
class(tMesh_grid) :: self
real(pReal), dimension(:,:), intent(in) :: nodes
call self%tMesh%init('grid',10_pInt,nodes)
end subroutine tMesh_grid_init
!--------------------------------------------------------------------------------------------------
!> @brief initializes the mesh by calling all necessary private routines the mesh module
!! Order and routines strongly depend on type of solver
!> @brief reads the geometry file to obtain information on discretization
!--------------------------------------------------------------------------------------------------
subroutine mesh_init(ip,el)
#include <petsc/finclude/petscsys.h>
use PETScsys
integer, intent(in), optional :: el, ip ! for compatibility reasons
use DAMASK_interface
use IO, only: &
IO_error
use debug, only: &
debug_e, &
debug_i, &
debug_level, &
debug_mesh, &
debug_levelBasic
use numerics, only: &
numerics_unitlength
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP
implicit none
include 'fftw3-mpi.f03'
integer(C_INTPTR_T) :: devNull, local_K, local_K_offset
integer :: ierr, worldsize, j
integer(pInt), intent(in), optional :: el, ip
logical :: myDebug
real(pReal), dimension(3) :: &
mySize !< domain size of this process
integer, dimension(3) :: &
myGrid !< domain grid of this process
integer, dimension(:), allocatable :: &
microstructureAt, &
homogenizationAt
integer :: j
integer(C_INTPTR_T) :: &
devNull, z, z_offset
write(6,'(/,a)') ' <<<+- mesh init -+>>>'
mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh
myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt)
call fftw_mpi_init()
call mesh_spectral_read_grid()
call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size')
if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)')
call readGeom(grid,geomSize,microstructureAt,homogenizationAt)
!--------------------------------------------------------------------------------------------------
! grid solver specific quantities
if(worldsize>grid(3)) call IO_error(894, ext_msg='number of processes exceeds grid(3)')
call fftw_mpi_init
devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), &
int(grid(2),C_INTPTR_T), &
int(grid(1),C_INTPTR_T)/2+1, &
PETSC_COMM_WORLD, &
local_K, & ! domain grid size along z
local_K_offset) ! domain grid offset along z
grid3 = int(local_K,pInt)
grid3Offset = int(local_K_offset,pInt)
z, & ! domain grid size along z
z_offset) ! domain grid offset along z
grid3 = int(z)
grid3Offset = int(z_offset)
size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal)
size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal)
myGrid = [grid(1:2),grid3]
mySize = [geomSize(1:2),size3]
mesh_NcpElemsGlobal = product(grid)
mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt)
mesh_node0 = mesh_spectral_build_nodes()
mesh_node = mesh_node0
if (myDebug) write(6,'(a)') ' Built nodes'; flush(6)
call theMesh%init(mesh_node)
call theMesh%setNelems(product(grid(1:2))*grid3)
call mesh_spectral_build_elements()
mesh_homogenizationAt = mesh_homogenizationAt(product(grid(1:2))*grid3Offset+1: &
!--------------------------------------------------------------------------------------------------
! general discretization
microstructureAt = microstructureAt(product(grid(1:2))*grid3Offset+1: &
product(grid(1:2))*(grid3Offset+grid3)) ! reallocate/shrink in case of MPI
homogenizationAt = homogenizationAt(product(grid(1:2))*grid3Offset+1: &
product(grid(1:2))*(grid3Offset+grid3)) ! reallocate/shrink in case of MPI
if (myDebug) write(6,'(a)') ' Built elements'; flush(6)
mesh_ipCoordinates = IPcoordinates(myGrid,mySize,grid3Offset)
call discretization_init(homogenizationAt,microstructureAt, &
reshape(mesh_ipCoordinates,[3,product(myGrid)]), &
Nodes(myGrid,mySize,grid3Offset))
FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements
allocate(FEsolving_execIP(2,product(myGrid)),source=1) ! parallel loop bounds set to comprise the only IP
!--------------------------------------------------------------------------------------------------
! geometry information required by the nonlocal CP model
call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pReal)),j=1,product(myGrid))], &
[1,product(myGrid)]))
call geometry_plastic_nonlocal_setIParea (cellEdgeArea(mySize,myGrid))
call geometry_plastic_nonlocal_setIPareaNormal (cellEdgeNormal(product(myGrid)))
call geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood(myGrid))
if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6)
mesh_ipCoordinates = mesh_build_ipCoordinates()
if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6)
allocate(mesh_ipVolume(1,theMesh%nElems),source=product([geomSize(1:2),size3]/real([grid(1:2),grid3])))
if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6)
mesh_ipArea = mesh_build_ipAreas()
mesh_ipAreaNormal = mesh_build_ipNormals()
if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6)
call mesh_spectral_build_ipNeighborhood
call geometry_plastic_nonlocal_set_IPneighborhood(mesh_ipNeighborhood)
if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6)
if (debug_e < 1 .or. debug_e > theMesh%nElems) &
call IO_error(602_pInt,ext_msg='element') ! selected element does not exist
if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) &
call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP
FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements
allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP...
forall (j = 1_pInt:theMesh%nElems) FEsolving_execIP(2,j) = theMesh%elem%nIPs ! ...up to own IP count for each element
!!!! COMPATIBILITY HACK !!!!
theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:)
!!!!!!!!!!!!!!!!!!!!!!!!
!--------------------------------------------------------------------------------------------------
! sanity checks for debugging
if (debug_e < 1 .or. debug_e > product(myGrid)) call IO_error(602,ext_msg='element') ! selected element does not exist
if (debug_i /= 1) call IO_error(602,ext_msg='IP') ! selected IP does not exist
end subroutine mesh_init
@ -219,24 +121,20 @@ end subroutine mesh_init
!> @details important variables have an implicit "save" attribute. Therefore, this function is
! supposed to be called only once!
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_read_grid()
use IO, only: &
IO_stringPos, &
IO_lc, &
IO_stringValue, &
IO_intValue, &
IO_floatValue, &
IO_error
use DAMASK_interface, only: &
geometryFile
subroutine readGeom(grid,geomSize,microstructure,homogenization)
integer, dimension(3), intent(out) :: grid ! grid (for all processes!)
real(pReal), dimension(3), intent(out) :: geomSize ! size (for all processes!)
integer, dimension(:), intent(out), allocatable :: &
microstructure, &
homogenization
implicit none
character(len=:), allocatable :: rawData
character(len=65536) :: line
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: h =- 1_pInt
integer(pInt) :: &
headerLength = -1_pInt, & !< length of header (in lines)
integer, allocatable, dimension(:) :: chunkPos
integer :: &
h =- 1, &
headerLength = -1, & !< length of header (in lines)
fileLength, & !< length of the geom file (in characters)
fileUnit, &
startPos, endPos, &
@ -247,15 +145,15 @@ subroutine mesh_spectral_read_grid()
e, & !< "element", i.e. spectral collocation point
i, j
grid = -1_pInt
grid = -1
geomSize = -1.0_pReal
!--------------------------------------------------------------------------------------------------
! read data as stream
! read raw data as stream
inquire(file = trim(geometryFile), size=fileLength)
open(newunit=fileUnit, file=trim(geometryFile), access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(geometryFile))
if(myStat /= 0) call IO_error(100,ext_msg=trim(geometryFile))
allocate(character(len=fileLength)::rawData)
read(fileUnit) rawData
close(fileUnit)
@ -265,355 +163,318 @@ subroutine mesh_spectral_read_grid()
endPos = index(rawData,new_line(''))
if(endPos <= index(rawData,'head')) then
startPos = len(rawData)
call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid')
call IO_error(error_ID=841, ext_msg='readGeom')
else
chunkPos = IO_stringPos(rawData(1:endPos))
if (chunkPos(1) < 2_pInt) call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid')
headerLength = IO_intValue(rawData(1:endPos),chunkPos,1_pInt)
startPos = endPos + 1_pInt
if (chunkPos(1) < 2) call IO_error(error_ID=841, ext_msg='readGeom')
headerLength = IO_intValue(rawData(1:endPos),chunkPos,1)
startPos = endPos + 1
endif
!--------------------------------------------------------------------------------------------------
! read and interprete header
l = 0
do while (l < headerLength .and. startPos < len(rawData))
endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt
endPos = startPos + index(rawData(startPos:),new_line('')) - 1
if (endPos < startPos) endPos = len(rawData) ! end of file without new line
line = rawData(startPos:endPos)
startPos = endPos + 1_pInt
l = l + 1_pInt
startPos = endPos + 1
l = l + 1
chunkPos = IO_stringPos(trim(line))
if (chunkPos(1) < 2) cycle ! need at least one keyword value pair
select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) )
select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1,.true.)) )
case ('grid')
if (chunkPos(1) > 6) then
do j = 2_pInt,6_pInt,2_pInt
do j = 2,6,2
select case (IO_lc(IO_stringValue(line,chunkPos,j)))
case('a')
grid(1) = IO_intValue(line,chunkPos,j+1_pInt)
grid(1) = IO_intValue(line,chunkPos,j+1)
case('b')
grid(2) = IO_intValue(line,chunkPos,j+1_pInt)
grid(2) = IO_intValue(line,chunkPos,j+1)
case('c')
grid(3) = IO_intValue(line,chunkPos,j+1_pInt)
grid(3) = IO_intValue(line,chunkPos,j+1)
end select
enddo
endif
case ('size')
if (chunkPos(1) > 6) then
do j = 2_pInt,6_pInt,2_pInt
do j = 2,6,2
select case (IO_lc(IO_stringValue(line,chunkPos,j)))
case('x')
geomSize(1) = IO_floatValue(line,chunkPos,j+1_pInt)
geomSize(1) = IO_floatValue(line,chunkPos,j+1)
case('y')
geomSize(2) = IO_floatValue(line,chunkPos,j+1_pInt)
geomSize(2) = IO_floatValue(line,chunkPos,j+1)
case('z')
geomSize(3) = IO_floatValue(line,chunkPos,j+1_pInt)
geomSize(3) = IO_floatValue(line,chunkPos,j+1)
end select
enddo
endif
case ('homogenization')
if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2_pInt)
if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2)
end select
enddo
!--------------------------------------------------------------------------------------------------
! sanity checks
if(h < 1_pInt) &
call IO_error(error_ID = 842_pInt, ext_msg='homogenization (mesh_spectral_read_grid)')
if(any(grid < 1_pInt)) &
call IO_error(error_ID = 842_pInt, ext_msg='grid (mesh_spectral_read_grid)')
if(h < 1) &
call IO_error(error_ID = 842, ext_msg='homogenization (readGeom)')
if(any(grid < 1)) &
call IO_error(error_ID = 842, ext_msg='grid (readGeom)')
if(any(geomSize < 0.0_pReal)) &
call IO_error(error_ID = 842_pInt, ext_msg='size (mesh_spectral_read_grid)')
call IO_error(error_ID = 842, ext_msg='size (readGeom)')
allocate(microGlobal(product(grid)), source = -1_pInt)
allocate(mesh_homogenizationAt(product(grid)), source = h) ! too large in case of MPI (shrink later, not very elegant)
allocate(microstructure(product(grid)), source = -1) ! too large in case of MPI (shrink later, not very elegant)
allocate(homogenization(product(grid)), source = h) ! too large in case of MPI (shrink later, not very elegant)
!--------------------------------------------------------------------------------------------------
! read and interpret content
e = 1_pInt
e = 1
do while (startPos < len(rawData))
endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt
endPos = startPos + index(rawData(startPos:),new_line('')) - 1
if (endPos < startPos) endPos = len(rawData) ! end of file without new line
line = rawData(startPos:endPos)
startPos = endPos + 1_pInt
l = l + 1_pInt
startPos = endPos + 1
l = l + 1
chunkPos = IO_stringPos(trim(line))
noCompression: if (chunkPos(1) /= 3) then
c = chunkPos(1)
microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)]
microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)]
else noCompression
compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then
c = IO_intValue(line,chunkPos,1)
microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))]
microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,3),i = 1,IO_intValue(line,chunkPos,1))]
else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then compression
c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1_pInt
o = merge(+1_pInt, -1_pInt, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1))
microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)]
c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1
o = merge(+1, -1, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1))
microstructure(e:e+c-1) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)]
else compression
c = chunkPos(1)
microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)]
microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)]
endif compression
endif noCompression
e = e+c
end do
if (e-1 /= product(grid)) call IO_error(error_ID = 843_pInt, el=e)
if (e-1 /= product(grid)) call IO_error(error_ID = 843, el=e)
end subroutine mesh_spectral_read_grid
end subroutine readGeom
!---------------------------------------------------------------------------------------------------
!> @brief Calculates position of nodes (pretend to be an element)
!> @brief Calculate position of IPs/cell centres (pretend to be an element)
!---------------------------------------------------------------------------------------------------
pure function mesh_spectral_build_nodes()
function IPcoordinates(grid,geomSize,grid3Offset)
real(pReal), dimension(3,mesh_Nnodes) :: mesh_spectral_build_nodes
integer :: n,a,b,c
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, intent(in) :: grid3Offset ! grid(3) offset
real(pReal), dimension(3,1,product(grid)) :: ipCoordinates
integer :: &
a,b,c, &
i
i = 0
do c = 1, grid(3); do b = 1, grid(2); do a = 1, grid(1)
i = i + 1
IPcoordinates(1:3,1,i) = geomSize/real(grid,pReal) * (real([a,b,grid3Offset+c],pReal) -0.5_pReal)
enddo; enddo; enddo
end function IPcoordinates
!---------------------------------------------------------------------------------------------------
!> @brief Calculate position of nodes (pretend to be an element)
!---------------------------------------------------------------------------------------------------
pure function nodes(grid,geomSize,grid3Offset)
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, intent(in) :: grid3Offset ! grid(3) offset
real(pReal), dimension(3,product(grid+1)) :: nodes
integer :: &
a,b,c, &
n
n = 0
do c = 0, grid3
do b = 0, grid(2)
do a = 0, grid(1)
do c = 0, grid3; do b = 0, grid(2); do a = 0, grid(1)
n = n + 1
mesh_spectral_build_nodes(1:3,n) = geomSize/real(grid,pReal) * real([a,b,grid3Offset+c],pReal)
enddo
enddo
enddo
nodes(1:3,n) = geomSize/real(grid,pReal) * real([a,b,grid3Offset+c],pReal)
enddo; enddo; enddo
end function mesh_spectral_build_nodes
!---------------------------------------------------------------------------------------------------
!> @brief Calculates position of IPs/cell centres (pretend to be an element)
!---------------------------------------------------------------------------------------------------
function mesh_build_ipCoordinates()
real(pReal), dimension(3,1,theMesh%nElems) :: mesh_build_ipCoordinates
integer :: n,a,b,c
n = 0
do c = 1, grid3
do b = 1, grid(2)
do a = 1, grid(1)
n = n + 1
mesh_build_ipCoordinates(1:3,1,n) = geomSize/real(grid,pReal) * (real([a,b,grid3Offset+c],pReal) -0.5_pReal)
enddo
enddo
enddo
end function mesh_build_ipCoordinates
end function nodes
!--------------------------------------------------------------------------------------------------
!> @brief Store FEid, type, material, texture, and node list per element.
!! Allocates global array 'mesh_element'
!> @brief Calculate IP interface areas
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_elements()
integer(pInt) :: &
e, &
elemOffset
pure function cellEdgeArea(geomSize,grid)
real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt)
real(pReal), dimension(6,1,product(grid)) :: cellEdgeArea
elemOffset = product(grid(1:2))*grid3Offset
do e=1, theMesh%nElems
mesh_element( 1,e) = -1_pInt ! DEPRECATED
mesh_element( 2,e) = -1_pInt ! DEPRECATED
mesh_element( 3,e) = mesh_homogenizationAt(e)
mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure
mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + &
((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node
mesh_element( 6,e) = mesh_element(5,e) + 1_pInt
mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt
mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt
mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node
mesh_element(10,e) = mesh_element(9,e) + 1_pInt
mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt
mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt
enddo
cellEdgeArea(1:2,1,:) = geomSize(2)/real(grid(2)) * geomSize(3)/real(grid(3))
cellEdgeArea(3:4,1,:) = geomSize(3)/real(grid(3)) * geomSize(1)/real(grid(1))
cellEdgeArea(5:6,1,:) = geomSize(1)/real(grid(1)) * geomSize(2)/real(grid(2))
end subroutine mesh_spectral_build_elements
end function cellEdgeArea
!--------------------------------------------------------------------------------------------------
!> @brief build neighborhood relations for spectral
!> @details assign globals: mesh_ipNeighborhood
!> @brief Calculate IP interface areas normals
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_ipNeighborhood
pure function cellEdgeNormal(nElems)
implicit none
integer(pInt) :: &
integer, intent(in) :: nElems
real, dimension(3,6,1,nElems) :: cellEdgeNormal
cellEdgeNormal(1:3,1,1,:) = spread([+1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
cellEdgeNormal(1:3,2,1,:) = spread([-1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
cellEdgeNormal(1:3,3,1,:) = spread([ 0.0_pReal,+1.0_pReal, 0.0_pReal],2,nElems)
cellEdgeNormal(1:3,4,1,:) = spread([ 0.0_pReal,-1.0_pReal, 0.0_pReal],2,nElems)
cellEdgeNormal(1:3,5,1,:) = spread([ 0.0_pReal, 0.0_pReal,+1.0_pReal],2,nElems)
cellEdgeNormal(1:3,6,1,:) = spread([ 0.0_pReal, 0.0_pReal,-1.0_pReal],2,nElems)
end function cellEdgeNormal
!--------------------------------------------------------------------------------------------------
!> @brief Build IP neighborhood relations
!--------------------------------------------------------------------------------------------------
pure function IPneighborhood(grid)
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
integer, dimension(3,6,1,product(grid)) :: IPneighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
integer :: &
x,y,z, &
e
allocate(mesh_ipNeighborhood(3,6,1,theMesh%nElems),source=0_pInt)
e = 0_pInt
do z = 0_pInt,grid3-1_pInt
do y = 0_pInt,grid(2)-1_pInt
do x = 0_pInt,grid(1)-1_pInt
e = e + 1_pInt
mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) &
e = 0
do z = 0,grid(3)-1; do y = 0,grid(2)-1; do x = 0,grid(1)-1
e = e + 1
IPneighborhood(1,1,1,e) = z * grid(1) * grid(2) &
+ y * grid(1) &
+ modulo(x+1_pInt,grid(1)) &
+ 1_pInt
mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) &
+ modulo(x+1,grid(1)) &
+ 1
IPneighborhood(1,2,1,e) = z * grid(1) * grid(2) &
+ y * grid(1) &
+ modulo(x-1_pInt,grid(1)) &
+ 1_pInt
mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) &
+ modulo(y+1_pInt,grid(2)) * grid(1) &
+ modulo(x-1,grid(1)) &
+ 1
IPneighborhood(1,3,1,e) = z * grid(1) * grid(2) &
+ modulo(y+1,grid(2)) * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) &
+ modulo(y-1_pInt,grid(2)) * grid(1) &
+ 1
IPneighborhood(1,4,1,e) = z * grid(1) * grid(2) &
+ modulo(y-1,grid(2)) * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) &
+ 1
IPneighborhood(1,5,1,e) = modulo(z+1,grid(3)) * grid(1) * grid(2) &
+ y * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) &
+ 1
IPneighborhood(1,6,1,e) = modulo(z-1,grid(3)) * grid(1) * grid(2) &
+ y * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt
mesh_ipNeighborhood(3,1,1,e) = 2_pInt
mesh_ipNeighborhood(3,2,1,e) = 1_pInt
mesh_ipNeighborhood(3,3,1,e) = 4_pInt
mesh_ipNeighborhood(3,4,1,e) = 3_pInt
mesh_ipNeighborhood(3,5,1,e) = 6_pInt
mesh_ipNeighborhood(3,6,1,e) = 5_pInt
enddo
enddo
enddo
end subroutine mesh_spectral_build_ipNeighborhood
!--------------------------------------------------------------------------------------------------
!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes)
!--------------------------------------------------------------------------------------------------
function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes)
use debug, only: &
debug_mesh, &
debug_level, &
debug_levelBasic
real(pReal), intent(in), dimension(:,:,:,:) :: &
centres
real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: &
nodes
real(pReal), intent(in), dimension(3) :: &
gDim
real(pReal), intent(in), dimension(3,3) :: &
Favg
real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: &
wrappedCentres
integer(pInt) :: &
i,j,k,n
integer(pInt), dimension(3), parameter :: &
diag = 1_pInt
integer(pInt), dimension(3) :: &
shift = 0_pInt, &
lookup = 0_pInt, &
me = 0_pInt, &
iRes = 0_pInt
integer(pInt), dimension(3,8) :: &
neighbor = reshape([ &
0_pInt, 0_pInt, 0_pInt, &
1_pInt, 0_pInt, 0_pInt, &
1_pInt, 1_pInt, 0_pInt, &
0_pInt, 1_pInt, 0_pInt, &
0_pInt, 0_pInt, 1_pInt, &
1_pInt, 0_pInt, 1_pInt, &
1_pInt, 1_pInt, 1_pInt, &
0_pInt, 1_pInt, 1_pInt ], [3,8])
!--------------------------------------------------------------------------------------------------
! initializing variables
iRes = [size(centres,2),size(centres,3),size(centres,4)]
nodes = 0.0_pReal
wrappedCentres = 0.0_pReal
!--------------------------------------------------------------------------------------------------
! report
if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then
write(6,'(a)') ' Meshing cubes around centroids'
write(6,'(a,3(e12.5))') ' Dimension: ', gDim
write(6,'(a,3(i5))') ' Resolution:', iRes
endif
!--------------------------------------------------------------------------------------------------
! building wrappedCentres = centroids + ghosts
wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres
do k = 0_pInt,iRes(3)+1_pInt
do j = 0_pInt,iRes(2)+1_pInt
do i = 0_pInt,iRes(1)+1_pInt
if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin
j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin
i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin
me = [i,j,k] ! me on skin
shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me)
lookup = me-diag+shift*iRes
wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = &
centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) &
- matmul(Favg, real(shift,pReal)*gDim)
endif
+ 1
IPneighborhood(2,1:6,1,e) = 1
IPneighborhood(3,1,1,e) = 2
IPneighborhood(3,2,1,e) = 1
IPneighborhood(3,3,1,e) = 4
IPneighborhood(3,4,1,e) = 3
IPneighborhood(3,5,1,e) = 6
IPneighborhood(3,6,1,e) = 5
enddo; enddo; enddo
!--------------------------------------------------------------------------------------------------
! averaging
do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1)
do n = 1_pInt,8_pInt
nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = &
nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), &
j+1_pInt+neighbor(2,n), &
k+1_pInt+neighbor(3,n) )
enddo
enddo; enddo; enddo
nodes = nodes/8.0_pReal
end function mesh_nodesAroundCentres
end function IPneighborhood
!--------------------------------------------------------------------------------------------------
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal'
!--------------------------------------------------------------------------------------------------
pure function mesh_build_ipAreas()
real(pReal), dimension(6,1,theMesh%nElems) :: mesh_build_ipAreas
mesh_build_ipAreas(1:2,1,:) = geomSize(2)/real(grid(2)) * geomSize(3)/real(grid(3))
mesh_build_ipAreas(3:4,1,:) = geomSize(3)/real(grid(3)) * geomSize(1)/real(grid(1))
mesh_build_ipAreas(5:6,1,:) = geomSize(1)/real(grid(1)) * geomSize(2)/real(grid(2))
end function mesh_build_ipAreas
!--------------------------------------------------------------------------------------------------
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal'
!--------------------------------------------------------------------------------------------------
pure function mesh_build_ipNormals()
real, dimension(3,6,1,theMesh%nElems) :: mesh_build_ipNormals
mesh_build_ipNormals(1:3,1,1,:) = spread([+1.0_pReal, 0.0_pReal, 0.0_pReal],2,theMesh%nElems)
mesh_build_ipNormals(1:3,2,1,:) = spread([-1.0_pReal, 0.0_pReal, 0.0_pReal],2,theMesh%nElems)
mesh_build_ipNormals(1:3,3,1,:) = spread([ 0.0_pReal,+1.0_pReal, 0.0_pReal],2,theMesh%nElems)
mesh_build_ipNormals(1:3,4,1,:) = spread([ 0.0_pReal,-1.0_pReal, 0.0_pReal],2,theMesh%nElems)
mesh_build_ipNormals(1:3,5,1,:) = spread([ 0.0_pReal, 0.0_pReal,+1.0_pReal],2,theMesh%nElems)
mesh_build_ipNormals(1:3,6,1,:) = spread([ 0.0_pReal, 0.0_pReal,-1.0_pReal],2,theMesh%nElems)
end function mesh_build_ipNormals
!!--------------------------------------------------------------------------------------------------
!!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes)
!!--------------------------------------------------------------------------------------------------
!function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes)
!
! real(pReal), intent(in), dimension(:,:,:,:) :: &
! centres
! real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: &
! nodes
! real(pReal), intent(in), dimension(3) :: &
! gDim
! real(pReal), intent(in), dimension(3,3) :: &
! Favg
! real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: &
! wrappedCentres
!
! integer :: &
! i,j,k,n
! integer, dimension(3), parameter :: &
! diag = 1
! integer, dimension(3) :: &
! shift = 0, &
! lookup = 0, &
! me = 0, &
! iRes = 0
! integer, dimension(3,8) :: &
! neighbor = reshape([ &
! 0, 0, 0, &
! 1, 0, 0, &
! 1, 1, 0, &
! 0, 1, 0, &
! 0, 0, 1, &
! 1, 0, 1, &
! 1, 1, 1, &
! 0, 1, 1 ], [3,8])
!
!!--------------------------------------------------------------------------------------------------
!! initializing variables
! iRes = [size(centres,2),size(centres,3),size(centres,4)]
! nodes = 0.0_pReal
! wrappedCentres = 0.0_pReal
!
!!--------------------------------------------------------------------------------------------------
!! building wrappedCentres = centroids + ghosts
! wrappedCentres(1:3,2:iRes(1)+1,2:iRes(2)+1,2:iRes(3)+1) = centres
! do k = 0,iRes(3)+1
! do j = 0,iRes(2)+1
! do i = 0,iRes(1)+1
! if (k==0 .or. k==iRes(3)+1 .or. & ! z skin
! j==0 .or. j==iRes(2)+1 .or. & ! y skin
! i==0 .or. i==iRes(1)+1 ) then ! x skin
! me = [i,j,k] ! me on skin
! shift = sign(abs(iRes+diag-2*me)/(iRes+diag),iRes+diag-2*me)
! lookup = me-diag+shift*iRes
! wrappedCentres(1:3,i+1, j+1, k+1) = &
! centres(1:3,lookup(1)+1,lookup(2)+1,lookup(3)+1) &
! - matmul(Favg, real(shift,pReal)*gDim)
! endif
! enddo; enddo; enddo
!
!!--------------------------------------------------------------------------------------------------
!! averaging
! do k = 0,iRes(3); do j = 0,iRes(2); do i = 0,iRes(1)
! do n = 1,8
! nodes(1:3,i+1,j+1,k+1) = &
! nodes(1:3,i+1,j+1,k+1) + wrappedCentres(1:3,i+1+neighbor(1,n), &
! j+1+neighbor(2,n), &
! k+1+neighbor(3,n) )
! enddo
! enddo; enddo; enddo
! nodes = nodes/8.0_pReal
!
!end function mesh_nodesAroundCentres
end module mesh

1455
src/mesh_marc.f90
View File

File diff suppressed because it is too large Load Diff

238
src/numerics.f90
View File

@ -5,17 +5,24 @@
!--------------------------------------------------------------------------------------------------
module numerics
use prec
use IO
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
use petscsys
#endif
!$ use OMP_LIB
implicit none
private
integer(pInt), protected, public :: &
iJacoStiffness = 1_pInt, & !< frequency of stiffness update
nMPstate = 10_pInt, & !< materialpoint state loop limit
randomSeed = 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 = 1_pInt, & !< MPI worldsize (/=1 for MPI simulations only)
numerics_integrator = 1_pInt !< method used for state integration Default 1: fix-point iteration
integer, protected, public :: &
iJacoStiffness = 1, & !< frequency of stiffness update
nMPstate = 10, & !< materialpoint state loop limit
randomSeed = 0, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed
worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only)
worldsize = 1, & !< MPI worldsize (/=1 for MPI simulations only)
numerics_integrator = 1 !< method used for state integration Default 1: fix-point iteration
integer(4), protected, public :: &
DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
real(pReal), protected, public :: &
@ -51,11 +58,11 @@ module numerics
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
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
integer, protected, public :: &
itmax = 250, & !< maximum number of iterations
itmin = 1, & !< minimum number of iterations
stagItMax = 10, & !< max number of field level staggered iterations
maxCutBack = 3 !< max number of cut backs
!--------------------------------------------------------------------------------------------------
! spectral parameters:
@ -83,9 +90,9 @@ module numerics
!--------------------------------------------------------------------------------------------------
! FEM parameters:
#ifdef FEM
integer(pInt), protected, public :: &
integrationOrder = 2_pInt, & !< order of quadrature rule required
structOrder = 2_pInt !< order of displacement shape functions
integer, protected, public :: &
integrationOrder = 2, & !< order of quadrature rule required
structOrder = 2 !< order of displacement shape functions
logical, protected, public :: &
BBarStabilisation = .false.
character(len=4096), protected, public :: &
@ -113,24 +120,9 @@ contains
! a sanity check
!--------------------------------------------------------------------------------------------------
subroutine numerics_init
use IO, only: &
IO_read_ASCII, &
IO_error, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_lc, &
IO_floatValue, &
IO_intValue, &
IO_warning
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
use petscsys
#endif
!$ use OMP_LIB, only: omp_set_num_threads
!$ integer :: gotDAMASK_NUM_THREADS = 1
integer :: i,j, ierr ! no pInt
integer(pInt), allocatable, dimension(:) :: chunkPos
integer :: i,j, ierr
integer, allocatable, dimension(:) :: chunkPos
character(len=pStringLen), dimension(:), allocatable :: fileContent
character(len=pStringLen) :: &
tag ,&
@ -146,7 +138,7 @@ subroutine numerics_init
!$ 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')
!$ call IO_warning(35,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END')
!$ DAMASK_NumThreadsInt = 1_4
!$ else
!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer
@ -170,128 +162,128 @@ subroutine numerics_init
enddo
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
select case(tag)
case ('defgradtolerance')
defgradTolerance = IO_floatValue(line,chunkPos,2_pInt)
defgradTolerance = IO_floatValue(line,chunkPos,2)
case ('ijacostiffness')
iJacoStiffness = IO_intValue(line,chunkPos,2_pInt)
iJacoStiffness = IO_intValue(line,chunkPos,2)
case ('nmpstate')
nMPstate = IO_intValue(line,chunkPos,2_pInt)
nMPstate = IO_intValue(line,chunkPos,2)
case ('substepminhomog')
subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt)
subStepMinHomog = IO_floatValue(line,chunkPos,2)
case ('substepsizehomog')
subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt)
subStepSizeHomog = IO_floatValue(line,chunkPos,2)
case ('stepincreasehomog')
stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt)
stepIncreaseHomog = IO_floatValue(line,chunkPos,2)
case ('integrator')
numerics_integrator = IO_intValue(line,chunkPos,2_pInt)
numerics_integrator = IO_intValue(line,chunkPos,2)
case ('usepingpong')
usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
usepingpong = IO_intValue(line,chunkPos,2) > 0
case ('unitlength')
numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt)
numerics_unitlength = IO_floatValue(line,chunkPos,2)
!--------------------------------------------------------------------------------------------------
! RGC parameters
case ('atol_rgc')
absTol_RGC = IO_floatValue(line,chunkPos,2_pInt)
absTol_RGC = IO_floatValue(line,chunkPos,2)
case ('rtol_rgc')
relTol_RGC = IO_floatValue(line,chunkPos,2_pInt)
relTol_RGC = IO_floatValue(line,chunkPos,2)
case ('amax_rgc')
absMax_RGC = IO_floatValue(line,chunkPos,2_pInt)
absMax_RGC = IO_floatValue(line,chunkPos,2)
case ('rmax_rgc')
relMax_RGC = IO_floatValue(line,chunkPos,2_pInt)
relMax_RGC = IO_floatValue(line,chunkPos,2)
case ('perturbpenalty_rgc')
pPert_RGC = IO_floatValue(line,chunkPos,2_pInt)
pPert_RGC = IO_floatValue(line,chunkPos,2)
case ('relevantmismatch_rgc')
xSmoo_RGC = IO_floatValue(line,chunkPos,2_pInt)
xSmoo_RGC = IO_floatValue(line,chunkPos,2)
case ('viscositypower_rgc')
viscPower_RGC = IO_floatValue(line,chunkPos,2_pInt)
viscPower_RGC = IO_floatValue(line,chunkPos,2)
case ('viscositymodulus_rgc')
viscModus_RGC = IO_floatValue(line,chunkPos,2_pInt)
viscModus_RGC = IO_floatValue(line,chunkPos,2)
case ('refrelaxationrate_rgc')
refRelaxRate_RGC = IO_floatValue(line,chunkPos,2_pInt)
refRelaxRate_RGC = IO_floatValue(line,chunkPos,2)
case ('maxrelaxation_rgc')
maxdRelax_RGC = IO_floatValue(line,chunkPos,2_pInt)
maxdRelax_RGC = IO_floatValue(line,chunkPos,2)
case ('maxvoldiscrepancy_rgc')
maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2_pInt)
maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2)
case ('voldiscrepancymod_rgc')
volDiscrMod_RGC = IO_floatValue(line,chunkPos,2_pInt)
volDiscrMod_RGC = IO_floatValue(line,chunkPos,2)
case ('discrepancypower_rgc')
volDiscrPow_RGC = IO_floatValue(line,chunkPos,2_pInt)
volDiscrPow_RGC = IO_floatValue(line,chunkPos,2)
!--------------------------------------------------------------------------------------------------
! random seeding parameter
case ('random_seed','fixed_seed')
randomSeed = IO_intValue(line,chunkPos,2_pInt)
randomSeed = IO_intValue(line,chunkPos,2)
!--------------------------------------------------------------------------------------------------
! gradient parameter
case ('charlength')
charLength = IO_floatValue(line,chunkPos,2_pInt)
charLength = IO_floatValue(line,chunkPos,2)
case ('residualstiffness')
residualStiffness = IO_floatValue(line,chunkPos,2_pInt)
residualStiffness = IO_floatValue(line,chunkPos,2)
!--------------------------------------------------------------------------------------------------
! field parameters
case ('err_struct_tolabs')
err_struct_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
err_struct_tolAbs = IO_floatValue(line,chunkPos,2)
case ('err_struct_tolrel')
err_struct_tolRel = IO_floatValue(line,chunkPos,2_pInt)
err_struct_tolRel = IO_floatValue(line,chunkPos,2)
case ('err_thermal_tolabs')
err_thermal_tolabs = IO_floatValue(line,chunkPos,2_pInt)
err_thermal_tolabs = IO_floatValue(line,chunkPos,2)
case ('err_thermal_tolrel')
err_thermal_tolrel = IO_floatValue(line,chunkPos,2_pInt)
err_thermal_tolrel = IO_floatValue(line,chunkPos,2)
case ('err_damage_tolabs')
err_damage_tolabs = IO_floatValue(line,chunkPos,2_pInt)
err_damage_tolabs = IO_floatValue(line,chunkPos,2)
case ('err_damage_tolrel')
err_damage_tolrel = IO_floatValue(line,chunkPos,2_pInt)
err_damage_tolrel = IO_floatValue(line,chunkPos,2)
case ('itmax')
itmax = IO_intValue(line,chunkPos,2_pInt)
itmax = IO_intValue(line,chunkPos,2)
case ('itmin')
itmin = IO_intValue(line,chunkPos,2_pInt)
itmin = IO_intValue(line,chunkPos,2)
case ('maxcutback')
maxCutBack = IO_intValue(line,chunkPos,2_pInt)
maxCutBack = IO_intValue(line,chunkPos,2)
case ('maxstaggerediter')
stagItMax = IO_intValue(line,chunkPos,2_pInt)
stagItMax = IO_intValue(line,chunkPos,2)
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Grid
case ('err_div_tolabs')
err_div_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
err_div_tolAbs = IO_floatValue(line,chunkPos,2)
case ('err_div_tolrel')
err_div_tolRel = IO_floatValue(line,chunkPos,2_pInt)
err_div_tolRel = IO_floatValue(line,chunkPos,2)
case ('err_stress_tolrel')
err_stress_tolrel = IO_floatValue(line,chunkPos,2_pInt)
err_stress_tolrel = IO_floatValue(line,chunkPos,2)
case ('err_stress_tolabs')
err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt)
err_stress_tolabs = IO_floatValue(line,chunkPos,2)
case ('continuecalculation')
continueCalculation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
continueCalculation = IO_intValue(line,chunkPos,2) > 0
case ('petsc_options')
petsc_options = trim(line(chunkPos(4):))
case ('err_curl_tolabs')
err_curl_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
err_curl_tolAbs = IO_floatValue(line,chunkPos,2)
case ('err_curl_tolrel')
err_curl_tolRel = IO_floatValue(line,chunkPos,2_pInt)
err_curl_tolRel = IO_floatValue(line,chunkPos,2)
case ('polaralpha')
polarAlpha = IO_floatValue(line,chunkPos,2_pInt)
polarAlpha = IO_floatValue(line,chunkPos,2)
case ('polarbeta')
polarBeta = IO_floatValue(line,chunkPos,2_pInt)
polarBeta = IO_floatValue(line,chunkPos,2)
#endif
!--------------------------------------------------------------------------------------------------
! FEM parameters
#ifdef FEM
case ('integrationorder')
integrationorder = IO_intValue(line,chunkPos,2_pInt)
integrationorder = IO_intValue(line,chunkPos,2)
case ('structorder')
structorder = IO_intValue(line,chunkPos,2_pInt)
structorder = IO_intValue(line,chunkPos,2)
case ('petsc_options')
petsc_options = trim(line(chunkPos(4):))
case ('bbarstabilisation')
BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
BBarStabilisation = IO_intValue(line,chunkPos,2) > 0
#endif
end select
enddo
@ -334,7 +326,7 @@ subroutine numerics_init
!--------------------------------------------------------------------------------------------------
! Random seeding parameter
write(6,'(a16,1x,i16,/)') ' random_seed: ',randomSeed
if (randomSeed <= 0_pInt) &
if (randomSeed <= 0) &
write(6,'(a,/)') ' random seed will be generated!'
!--------------------------------------------------------------------------------------------------
@ -386,50 +378,50 @@ subroutine numerics_init
!--------------------------------------------------------------------------------------------------
! sanity checks
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 (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate')
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 (numerics_integrator <= 0_pInt .or. 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 (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 (defgradTolerance <= 0.0_pReal) call IO_error(301,ext_msg='defgradTolerance')
if (iJacoStiffness < 1) call IO_error(301,ext_msg='iJacoStiffness')
if (nMPstate < 1) call IO_error(301,ext_msg='nMPstate')
if (subStepMinHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinHomog')
if (subStepSizeHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeHomog')
if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog')
if (numerics_integrator <= 0 .or. numerics_integrator >= 6) &
call IO_error(301,ext_msg='integrator')
if (numerics_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength')
if (absTol_RGC <= 0.0_pReal) call IO_error(301,ext_msg='absTol_RGC')
if (relTol_RGC <= 0.0_pReal) call IO_error(301,ext_msg='relTol_RGC')
if (absMax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='absMax_RGC')
if (relMax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='relMax_RGC')
if (pPert_RGC <= 0.0_pReal) call IO_error(301,ext_msg='pPert_RGC')
if (xSmoo_RGC <= 0.0_pReal) call IO_error(301,ext_msg='xSmoo_RGC')
if (viscPower_RGC < 0.0_pReal) call IO_error(301,ext_msg='viscPower_RGC')
if (viscModus_RGC < 0.0_pReal) call IO_error(301,ext_msg='viscModus_RGC')
if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301,ext_msg='refRelaxRate_RGC')
if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='maxdRelax_RGC')
if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301,ext_msg='maxVolDiscr_RGC')
if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301,ext_msg='volDiscrMod_RGC')
if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301,ext_msg='volDiscrPw_RGC')
if (residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness')
if (itmax <= 1) call IO_error(301,ext_msg='itmax')
if (itmin > itmax .or. itmin < 1) call IO_error(301,ext_msg='itmin')
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
if (err_struct_tolRel <= 0.0_pReal) call IO_error(301,ext_msg='err_struct_tolRel')
if (err_struct_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_struct_tolAbs')
if (err_thermal_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_thermal_tolabs')
if (err_thermal_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_thermal_tolrel')
if (err_damage_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_damage_tolabs')
if (err_damage_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_damage_tolrel')
#ifdef Grid
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 (err_stress_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_stress_tolRel')
if (err_stress_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_stress_tolAbs')
if (err_div_tolRel < 0.0_pReal) call IO_error(301,ext_msg='err_div_tolRel')
if (err_div_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_div_tolAbs')
if (err_curl_tolRel < 0.0_pReal) call IO_error(301,ext_msg='err_curl_tolRel')
if (err_curl_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_curl_tolAbs')
if (polarAlpha <= 0.0_pReal .or. &
polarAlpha > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarAlpha')
polarAlpha > 2.0_pReal) call IO_error(301,ext_msg='polarAlpha')
if (polarBeta < 0.0_pReal .or. &
polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta')
polarBeta > 2.0_pReal) call IO_error(301,ext_msg='polarBeta')
#endif
end subroutine numerics_init

44
src/plastic_disloUCLA.f90
View File

@ -6,11 +6,18 @@
!> @brief crystal plasticity model for bcc metals, especially Tungsten
!--------------------------------------------------------------------------------------------------
module plastic_disloUCLA
use prec, only: &
pReal
use prec
use debug
use math
use IO
use material
use config
use lattice
use results
implicit none
private
integer, dimension(:,:), allocatable, target, public :: &
plastic_disloUCLA_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
@ -111,20 +118,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_init()
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use math, only: &
math_expand
use IO, only: &
IO_error
use material
use config, only: &
config_phase
use lattice
integer :: &
Ninstance, &
@ -394,12 +387,6 @@ end subroutine plastic_disloUCLA_LpAndItsTangent
!> @brief calculates the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_dotState(Mp,T,instance,of)
use prec, only: &
tol_math_check, &
dEq0
use math, only: &
PI, &
math_clip
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -489,11 +476,6 @@ end subroutine plastic_disloUCLA_dependentState
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_disloUCLA_postResults(Mp,T,instance,of) result(postResults)
use prec, only: &
dEq, dNeq0
use math, only: &
PI, &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -548,8 +530,6 @@ end function plastic_disloUCLA_postResults
!--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_results(instance,group)
#if defined(PETSc) || defined(DAMASK_HDF5)
use results, only: &
results_writeDataset
integer, intent(in) :: instance
character(len=*), intent(in) :: group
@ -595,12 +575,6 @@ end subroutine plastic_disloUCLA_results
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics(Mp,T,instance,of, &
dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg,tau_pos_out,tau_neg_out)
use prec, only: &
tol_math_check, &
dEq, dNeq0
use math, only: &
PI, &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress

244
src/plastic_nonlocal.f90
View File

@ -7,12 +7,22 @@
module plastic_nonlocal
use prec
use future
use IO
use math
use debug
use mesh
use material
use lattice
use rotations
use config
use lattice
use discretization
use geometry_plastic_nonlocal, only: &
periodicSurface => geometry_plastic_nonlocal_periodicSurface, &
nIPneighbors => geometry_plastic_nonlocal_nIPneighbors, &
IPneighborhood => geometry_plastic_nonlocal_IPneighborhood, &
IPvolume => geometry_plastic_nonlocal_IPvolume, &
IParea => geometry_plastic_nonlocal_IParea, &
IPareaNormal => geometry_plastic_nonlocal_IPareaNormal
IPvolume => geometry_plastic_nonlocal_IPvolume0, &
IParea => geometry_plastic_nonlocal_IParea0, &
IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0
implicit none
private
@ -241,21 +251,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_init
use prec, only: &
dEq0, dNeq0, dEq
use math, only: &
math_expand, math_cross
use IO, only: &
IO_error
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic
use mesh, only: &
theMesh
use material
use config
use lattice
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer, dimension(0), parameter :: emptyIntArray = [integer::]
@ -291,7 +286,6 @@ subroutine plastic_nonlocal_init
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances
allocate(param(maxNinstances))
allocate(state(maxNinstances))
allocate(dotState(maxNinstances))
@ -672,8 +666,8 @@ subroutine plastic_nonlocal_init
enddo
allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), &
source=0.0_pReal)
allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),nIPneighbors,&
discretization_nIP,discretization_nElem), source=0.0_pReal)
! BEGIN DEPRECATED----------------------------------------------------------------------------------
allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0)
@ -738,15 +732,6 @@ subroutine plastic_nonlocal_init
!> @brief populates the initial dislocation density
!--------------------------------------------------------------------------------------------------
subroutine stateInit(phase,NofMyPhase)
use math, only: &
math_sampleGaussVar
use mesh, only: &
theMesh, &
mesh_ipVolume
use material, only: &
material_phase, &
phase_plasticityInstance, &
phasememberAt
integer,intent(in) ::&
phase, &
@ -779,9 +764,9 @@ subroutine plastic_nonlocal_init
if (prm%rhoSglRandom > 0.0_pReal) then
! get the total volume of the instance
do e = 1,theMesh%nElems
do i = 1,theMesh%elem%nIPs
if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = mesh_ipVolume(i,e)
do e = 1,discretization_nElem
do i = 1,discretization_nIP
if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = IPvolume(i,e)
enddo
enddo
totalVolume = sum(volume)
@ -828,39 +813,6 @@ end subroutine plastic_nonlocal_init
!> @brief calculates quantities characterizing the microstructure
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
use prec, only: &
dEq0
use IO, only: &
IO_error
use math, only: &
PI, &
math_inner, &
math_inv33
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelExtensive, &
debug_levelSelective, &
debug_i, &
debug_e
#endif
use mesh, only: &
theMesh, &
mesh_ipNeighborhood, &
mesh_ipCoordinates, &
mesh_ipVolume, &
mesh_ipAreaNormal, &
mesh_ipArea
use material, only: &
material_phase, &
phase_localPlasticity, &
phaseAt, phasememberAt, &
phase_plasticityInstance
use lattice, only: &
LATTICE_bcc_ID, &
LATTICE_fcc_ID, &
lattice_structure
integer, intent(in) :: &
ip, &
@ -900,7 +852,7 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
invFp, & !< inverse of plastic deformation gradient
connections, &
invConnections
real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: &
real(pReal), dimension(3,nIPneighbors) :: &
connection_latticeConf
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: &
rhoExcess
@ -914,10 +866,10 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: &
myInteractionMatrix ! corrected slip interaction matrix
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),theMesh%elem%nIPneighbors) :: &
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),nIPneighbors) :: &
rho_edg_delta_neighbor, &
rho_scr_delta_neighbor
real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: &
real(pReal), dimension(2,maxval(totalNslip),nIPneighbors) :: &
neighbor_rhoExcess, & ! excess density at neighboring material point
neighbor_rhoTotal ! total density at neighboring material point
real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: &
@ -974,15 +926,15 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
rhoExcess(1,1:ns) = rho_edg_delta
rhoExcess(2,1:ns) = rho_scr_delta
FVsize = mesh_ipVolume(ip,el) ** (1.0_pReal/3.0_pReal)
FVsize = IPvolume(ip,el) ** (1.0_pReal/3.0_pReal)
!* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities
nRealNeighbors = 0.0_pReal
neighbor_rhoTotal = 0.0_pReal
do n = 1,theMesh%elem%nIPneighbors
neighbor_el = mesh_ipNeighborhood(1,n,ip,el)
neighbor_ip = mesh_ipNeighborhood(2,n,ip,el)
do n = 1,nIPneighbors
neighbor_el = IPneighborhood(1,n,ip,el)
neighbor_ip = IPneighborhood(2,n,ip,el)
no = phasememberAt(1,neighbor_ip,neighbor_el)
if (neighbor_el > 0 .and. neighbor_ip > 0) then
neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el))
@ -1000,9 +952,9 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
connection_latticeConf(1:3,n) = &
matmul(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) &
- mesh_ipCoordinates(1:3,ip,el))
normal_latticeConf = matmul(transpose(invFp), mesh_ipAreaNormal(1:3,n,ip,el))
normal_latticeConf = matmul(transpose(invFp), IPareaNormal(1:3,n,ip,el))
if (math_inner(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) & ! neighboring connection points in opposite direction to face normal: must be periodic image
connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el)/mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell
connection_latticeConf(1:3,n) = normal_latticeConf * IPvolume(ip,el)/IParea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell
else
! local neighbor or different lattice structure or different constitution instance -> use central values instead
connection_latticeConf(1:3,n) = 0.0_pReal
@ -1224,13 +1176,6 @@ end subroutine plastic_nonlocal_kinetics
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, &
Mp, Temperature, volume, ip, el)
use math, only: &
math_mul33xx33
use material, only: &
material_phase, &
plasticState, &
phaseAt, phasememberAt, &
phase_plasticityInstance
integer, intent(in) :: &
ip, & !< current integration point
@ -1363,26 +1308,6 @@ end subroutine plastic_nonlocal_LpAndItsTangent
!> @brief (instantaneous) incremental change of microstructure
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_deltaState(Mp,ip,el)
use prec, only: &
dNeq0
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective, &
debug_i, &
debug_e
#endif
use math, only: &
PI, &
math_mul33xx33
use material, only: &
material_phase, &
plasticState, &
phaseAt, phasememberAt, &
phase_plasticityInstance
integer, intent(in) :: &
ip, &
@ -1500,49 +1425,6 @@ end subroutine plastic_nonlocal_deltaState
!---------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
timestep,ip,el)
use, intrinsic :: &
IEEE_arithmetic
use prec, only: &
dNeq0, &
dNeq, &
dEq0
use IO, only: &
IO_error
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective, &
debug_i, &
debug_e
#endif
use math, only: &
math_inner, &
math_mul33xx33, &
math_inv33, &
math_det33, &
PI
use mesh, only: &
theMesh, &
mesh_ipNeighborhood, &
mesh_ipVolume, &
mesh_ipArea, &
mesh_ipAreaNormal
use material, only: &
homogenization_maxNgrains, &
material_phase, &
phase_plasticityInstance, &
phase_localPlasticity, &
plasticState, &
phaseAt, phasememberAt, &
phase_plasticity ,&
PLASTICITY_NONLOCAL_ID
use lattice, only: &
lattice_structure, &
LATTICE_bcc_ID, &
LATTICE_fcc_ID
integer, intent(in) :: &
ip, & !< current integration point
@ -1552,7 +1434,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
timestep !< substepped crystallite time increment
real(pReal), dimension(3,3), intent(in) ::&
Mp !< MandelStress
real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: &
real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: &
Fe, & !< elastic deformation gradient
Fp !< plastic deformation gradient
@ -1715,14 +1597,14 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
!*** check CFL (Courant-Friedrichs-Lewy) condition for flux
if (any( abs(gdot) > 0.0_pReal & ! any active slip system ...
.and. prm%CFLfactor * abs(v) * timestep &
> mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
> IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
#ifdef DEBUG
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then
write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip
write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', &
maxval(abs(v), abs(gdot) > 0.0_pReal &
.and. prm%CFLfactor * abs(v) * timestep &
> mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el))), &
> IPvolume(ip,el) / maxval(IParea(:,ip,el))), &
' at a timestep of ',timestep
write(6,'(a)') '<< CONST >> enforcing cutback !!!'
endif
@ -1743,18 +1625,18 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
my_Fe = Fe(1:3,1:3,1,ip,el)
my_F = matmul(my_Fe, Fp(1:3,1:3,1,ip,el))
neighbors: do n = 1,theMesh%elem%nIPneighbors
neighbors: do n = 1,nIPneighbors
neighbor_el = mesh_ipNeighborhood(1,n,ip,el)
neighbor_ip = mesh_ipNeighborhood(2,n,ip,el)
neighbor_n = mesh_ipNeighborhood(3,n,ip,el)
neighbor_el = IPneighborhood(1,n,ip,el)
neighbor_ip = IPneighborhood(2,n,ip,el)
neighbor_n = IPneighborhood(3,n,ip,el)
np = phaseAt(1,neighbor_ip,neighbor_el)
no = phasememberAt(1,neighbor_ip,neighbor_el)
opposite_neighbor = n + mod(n,2) - mod(n+1,2)
opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el)
opposite_ip = mesh_ipNeighborhood(2,opposite_neighbor,ip,el)
opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el)
opposite_el = IPneighborhood(1,opposite_neighbor,ip,el)
opposite_ip = IPneighborhood(2,opposite_neighbor,ip,el)
opposite_n = IPneighborhood(3,opposite_neighbor,ip,el)
if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient
neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el))
@ -1791,14 +1673,14 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
0.0_pReal)
endforall
where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN &
where (neighbor_rhoSgl * IPvolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN &
.or. neighbor_rhoSgl < prm%significantRho) &
neighbor_rhoSgl = 0.0_pReal
normal_neighbor2me_defConf = math_det33(Favg) * matmul(math_inv33(transpose(Favg)), &
mesh_ipAreaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!)
IPareaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!)
normal_neighbor2me = matmul(transpose(neighbor_Fe), normal_neighbor2me_defConf) &
/ math_det33(neighbor_Fe) ! interface normal in the lattice configuration of my neighbor
area = mesh_ipArea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me)
area = IParea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me)
normal_neighbor2me = normal_neighbor2me / norm2(normal_neighbor2me) ! normalize the surface normal to unit length
do s = 1,ns
do t = 1,4
@ -1810,11 +1692,11 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
* math_inner(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface
where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility...
rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) &
+ lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type
+ lineLength / IPvolume(ip,el) & ! ... transferring to equally signed mobile dislocation type
* compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal
where (compatibility(c,1:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility...
rhoDotFlux(1:ns,topp) = rhoDotFlux(1:ns,topp) &
+ lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type
+ lineLength / IPvolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type
* compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal
endif
enddo
@ -1842,10 +1724,10 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
normal_me2neighbor_defConf = math_det33(Favg) &
* matmul(math_inv33(transpose(Favg)), &
mesh_ipAreaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!)
IPareaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!)
normal_me2neighbor = matmul(transpose(my_Fe), normal_me2neighbor_defConf) &
/ math_det33(my_Fe) ! interface normal in my lattice configuration
area = mesh_ipArea(n,ip,el) * norm2(normal_me2neighbor)
area = IParea(n,ip,el) * norm2(normal_me2neighbor)
normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length
do s = 1,ns
do t = 1,4
@ -1858,9 +1740,9 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
endif
lineLength = my_rhoSgl(s,t) * my_v(s,t) &
* math_inner(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface
rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / mesh_ipVolume(ip,el) ! subtract dislocation flux from current type
rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / IPvolume(ip,el) ! subtract dislocation flux from current type
rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) &
+ lineLength / mesh_ipVolume(ip,el) * (1.0_pReal - transmissivity) &
+ lineLength / IPvolume(ip,el) * (1.0_pReal - transmissivity) &
* sign(1.0_pReal, my_v(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point
endif
enddo
@ -2001,26 +1883,11 @@ end subroutine plastic_nonlocal_dotState
! that sum up to a total of 1 are considered, all others are set to zero.
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
use math, only: &
math_inner, &
math_qRot
use rotations, only: &
rotation
use material, only: &
material_phase, &
material_texture, &
phase_localPlasticity, &
phase_plasticityInstance
use mesh, only: &
mesh_ipNeighborhood, &
theMesh
use lattice, only: &
lattice_qDisorientation
integer, intent(in) :: &
i, &
e
type(rotation), dimension(1,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: &
type(rotation), dimension(1,discretization_nIP,discretization_nElem), intent(in) :: &
orientation ! crystal orientation in quaternions
integer :: &
@ -2040,7 +1907,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),&
totalNslip(phase_plasticityInstance(material_phase(1,i,e))),&
theMesh%elem%nIPneighbors) :: &
nIPneighbors) :: &
my_compatibility ! my_compatibility for current element and ip
real(pReal) :: &
my_compatibilitySum, &
@ -2050,7 +1917,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
belowThreshold
type(rotation) :: rot
Nneighbors = theMesh%elem%nIPneighbors
Nneighbors = nIPneighbors
ph = material_phase(1,i,e)
textureID = material_texture(1,i,e)
instance = phase_plasticityInstance(ph)
@ -2065,8 +1932,8 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
!*** Loop thrugh neighbors and check whether there is any compatibility.
neighbors: do n = 1,Nneighbors
neighbor_e = mesh_ipNeighborhood(1,n,i,e)
neighbor_i = mesh_ipNeighborhood(2,n,i,e)
neighbor_e = IPneighborhood(1,n,i,e)
neighbor_i = IPneighborhood(2,n,i,e)
!* FREE SURFACE
@ -2159,10 +2026,6 @@ end subroutine plastic_nonlocal_updateCompatibility
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_nonlocal_postResults(ph,instance,of) result(postResults)
use prec, only: &
dNeq0
use material, only: &
plasticState
integer, intent(in) :: &
ph, &
@ -2364,7 +2227,6 @@ end function plastic_nonlocal_postResults
!> @details raw values is rectified
!--------------------------------------------------------------------------------------------------
function getRho(instance,of,ip,el)
use mesh
integer, intent(in) :: instance, of,ip,el
real(pReal), dimension(param(instance)%totalNslip,10) :: getRho
@ -2377,7 +2239,7 @@ function getRho(instance,of,ip,el)
getRho(:,mob) = max(getRho(:,mob),0.0_pReal)
getRho(:,dip) = max(getRho(:,dip),0.0_pReal)
where(abs(getRho) < max(prm%significantN/mesh_ipVolume(ip,el)**(2.0_pReal/3.0_pReal),prm%significantRho)) &
where(abs(getRho) < max(prm%significantN/IPvolume(ip,el)**(2.0_pReal/3.0_pReal),prm%significantRho)) &
getRho = 0.0_pReal
end associate

6
src/results.f90
View File

@ -15,6 +15,8 @@ module results
implicit none
private
#if defined(PETSc) || defined(DAMASK_HDF5)
integer(HID_T), public, protected :: tempCoordinates, tempResults
integer(HID_T), private :: resultsFile, currentIncID, plist_id
@ -105,7 +107,7 @@ end subroutine results_closeJobFile
!--------------------------------------------------------------------------------------------------
subroutine results_addIncrement(inc,time)
integer(pInt), intent(in) :: inc
integer, intent(in) :: inc
real(pReal), intent(in) :: time
character(len=pStringLen) :: incChar
@ -951,5 +953,5 @@ end subroutine results_mapping_materialpoint
!end subroutine HDF5_mappingCells
#endif
end module results

10
src/rotations.f90
View File

@ -65,6 +65,7 @@ module rotations
procedure, public :: asRotationMatrix
!------------------------------------------
procedure, public :: fromRotationMatrix
procedure, public :: fromEulerAngles
!------------------------------------------
procedure, public :: rotVector
procedure, public :: rotTensor
@ -143,7 +144,16 @@ subroutine fromRotationMatrix(self,om)
self%q = om2qu(om)
end subroutine
!---------------------------------------------------------------------------------------------------
subroutine fromEulerAngles(self,eu)
class(rotation), intent(out) :: self
real(pReal), dimension(3), intent(in) :: eu
self%q = eu2qu(eu)
end subroutine
!---------------------------------------------------------------------------------------------------
!---------------------------------------------------------------------------------------------------
!> @author Marc De Graef, Carnegie Mellon University

37
src/source_damage_anisoDuctile.f90
View File

@ -6,9 +6,15 @@
!--------------------------------------------------------------------------------------------------
module source_damage_anisoDuctile
use prec
use debug
use IO
use math
use material
use config
implicit none
private
integer, dimension(:), allocatable, public, protected :: &
source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_anisoDuctile_instance !< instance of damage source mechanism
@ -57,26 +63,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_init
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_error
use math, only: &
math_expand
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_anisoDuctile_label, &
SOURCE_damage_anisoDuctile_ID, &
material_phase, &
sourceState
use config, only: &
config_phase
integer :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p ,i
@ -181,13 +167,6 @@ 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_homogenizationAt, &
damage, &
damageMapping
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -222,8 +201,6 @@ end subroutine source_damage_anisoDuctile_dotState
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &
@ -249,8 +226,6 @@ end subroutine source_damage_anisoDuctile_getRateAndItsTangent
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_anisoDuctile_postResults(phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &

51
src/source_damage_isoBrittle.f90
View File

@ -6,23 +6,27 @@
!--------------------------------------------------------------------------------------------------
module source_damage_isoBrittle
use prec
use debug
use IO
use math
use material
use config
implicit none
private
integer, dimension(:), allocatable, public, protected :: &
source_damage_isoBrittle_offset, & !< which source is my current damage mechanism?
source_damage_isoBrittle_instance !< instance of damage source mechanism
source_damage_isoBrittle_offset, &
source_damage_isoBrittle_instance
integer, dimension(:,:), allocatable, target, public :: &
source_damage_isoBrittle_sizePostResult !< size of each post result output
source_damage_isoBrittle_sizePostResult
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_isoBrittle_output !< name of each post result output
source_damage_isoBrittle_output
enum, bind(c)
enumerator :: undefined_ID, &
enumerator :: &
undefined_ID, &
damage_drivingforce_ID
end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo
end enum
type, private :: tParameters !< container type for internal constitutive parameters
@ -34,7 +38,7 @@ module source_damage_isoBrittle
outputID
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -51,25 +55,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_init
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_error
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_isoBrittle_label, &
SOURCE_damage_isoBrittle_ID, &
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase
integer :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p,i
@ -164,12 +149,6 @@ 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
use math, only : &
math_sym33to6, &
math_I3
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -212,8 +191,6 @@ end subroutine source_damage_isoBrittle_deltaState
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &
@ -241,8 +218,6 @@ end subroutine source_damage_isoBrittle_getRateAndItsTangent
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_isoBrittle_postResults(phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &

34
src/source_damage_isoDuctile.f90
View File

@ -6,6 +6,10 @@
!--------------------------------------------------------------------------------------------------
module source_damage_isoDuctile
use prec
use debug
use IO
use material
use config
implicit none
private
@ -51,25 +55,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_init
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_error
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_isoDuctile_label, &
SOURCE_damage_isoDuctile_ID, &
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase
integer :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p,i
@ -164,13 +149,6 @@ 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_homogenizationAt, &
damage, &
damageMapping
integer, intent(in) :: &
ipc, & !< component-ID of integration point
@ -197,8 +175,6 @@ end subroutine source_damage_isoDuctile_dotState
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &
@ -224,8 +200,6 @@ end subroutine source_damage_isoDuctile_getRateAndItsTangent
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_isoDuctile_postResults(phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &

9
src/thermal_adiabatic.f90
View File

@ -11,7 +11,6 @@ module thermal_adiabatic
use source_thermal_externalheat
use crystallite
use lattice
use mesh
implicit none
private
@ -214,13 +213,13 @@ function thermal_adiabatic_getSpecificHeat(ip,el)
thermal_adiabatic_getSpecificHeat = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat + &
lattice_specificHeat(material_phase(grain,ip,el))
enddo
thermal_adiabatic_getSpecificHeat = &
thermal_adiabatic_getSpecificHeat/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
thermal_adiabatic_getSpecificHeat/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end function thermal_adiabatic_getSpecificHeat
@ -241,13 +240,13 @@ function thermal_adiabatic_getMassDensity(ip,el)
thermal_adiabatic_getMassDensity = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity + &
lattice_massDensity(material_phase(grain,ip,el))
enddo
thermal_adiabatic_getMassDensity = &
thermal_adiabatic_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
thermal_adiabatic_getMassDensity/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end function thermal_adiabatic_getMassDensity

85
src/thermal_conduction.f90
View File

@ -3,8 +3,13 @@
!> @brief material subroutine for temperature evolution from heat conduction
!--------------------------------------------------------------------------------------------------
module thermal_conduction
use prec, only: &
pReal
use prec
use material
use config
use lattice
use crystallite
use source_thermal_dissipation
use source_thermal_externalheat
implicit none
private
@ -42,21 +47,7 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_init
use material, only: &
thermal_type, &
thermal_typeInstance, &
homogenization_Noutput, &
THERMAL_conduction_label, &
THERMAL_conduction_ID, &
material_homogenizationAt, &
mappingHomogenization, &
thermalState, &
thermalMapping, &
thermal_initialT, &
temperature, &
temperatureRate
use config, only: &
config_homogenization
integer :: maxNinstance,section,instance,i
integer :: sizeState
@ -115,24 +106,6 @@ end subroutine thermal_conduction_init
!> @brief returns heat generation rate
!--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
use material, only: &
material_homogenizationAt, &
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_S, &
crystallite_Lp
integer, intent(in) :: &
ip, & !< integration point number
@ -193,15 +166,6 @@ 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, &
material_phase
use mesh, only: &
mesh_element
use crystallite, only: &
crystallite_push33ToRef
integer, intent(in) :: &
ip, & !< integration point number
@ -213,13 +177,13 @@ function thermal_conduction_getConductivity33(ip,el)
thermal_conduction_getConductivity33 = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
do grain = 1, homogenization_Ngrains(material_homogenizationAt(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/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
thermal_conduction_getConductivity33/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end function thermal_conduction_getConductivity33
@ -228,13 +192,6 @@ 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, &
material_phase
use mesh, only: &
mesh_element
integer, intent(in) :: &
ip, & !< integration point number
@ -247,13 +204,13 @@ function thermal_conduction_getSpecificHeat(ip,el)
thermal_conduction_getSpecificHeat = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat + &
lattice_specificHeat(material_phase(grain,ip,el))
enddo
thermal_conduction_getSpecificHeat = &
thermal_conduction_getSpecificHeat/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
thermal_conduction_getSpecificHeat/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end function thermal_conduction_getSpecificHeat
@ -261,13 +218,6 @@ 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, &
material_phase
use mesh, only: &
mesh_element
integer, intent(in) :: &
ip, & !< integration point number
@ -280,13 +230,13 @@ function thermal_conduction_getMassDensity(ip,el)
thermal_conduction_getMassDensity = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
thermal_conduction_getMassDensity = thermal_conduction_getMassDensity &
+ lattice_massDensity(material_phase(grain,ip,el))
enddo
thermal_conduction_getMassDensity = &
thermal_conduction_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
thermal_conduction_getMassDensity/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end function thermal_conduction_getMassDensity
@ -295,11 +245,6 @@ 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: &
material_homogenizationAt, &
temperature, &
temperatureRate, &
thermalMapping
integer, intent(in) :: &
ip, & !< integration point number
@ -323,8 +268,6 @@ end subroutine thermal_conduction_putTemperatureAndItsRate
!> @brief return array of thermal results
!--------------------------------------------------------------------------------------------------
function thermal_conduction_postResults(homog,instance,of) result(postResults)
use material, only: &
temperature
integer, intent(in) :: &
homog, &

11
src/thermal_isothermal.f90
View File

@ -3,6 +3,9 @@
!> @brief material subroutine for isothermal temperature field
!--------------------------------------------------------------------------------------------------
module thermal_isothermal
use prec
use config
use material
implicit none
private
@ -15,12 +18,7 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine thermal_isothermal_init()
use prec, only: &
pReal
use config, only: &
material_Nhomogenization
use material
subroutine thermal_isothermal_init
integer :: &
homog, &
@ -45,7 +43,6 @@ subroutine thermal_isothermal_init()
enddo initializeInstances
end subroutine thermal_isothermal_init
end module thermal_isothermal