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

Merge branch 'development' into New-Damage

This commit is contained in:
Martin Diehl 2019-02-12 23:37:39 +01:00
parent fd4ae71279 79b7ae1b3e
commit 01fe7a9731
95 changed files with 9162 additions and 15874 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -1,6 +1,7 @@
*.pyc
*.mod
*.o
*.hdf5
*.exe
*.bak
*~

48
.gitlab-ci.yml
View File

@ -158,12 +158,12 @@ Post_AverageDown:
- master
- release
#Post_General:
# stage: postprocessing
# script: PostProcessing/test.py
# except:
# - master
# - release
Post_General:
stage: postprocessing
script: PostProcessing/test.py
except:
- master
- release
Post_GeometryReconstruction:
stage: postprocessing
@ -343,6 +343,15 @@ Spectral_MPI:
- master
- release
SpectralAll_restartMPI:
stage: spectral
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- SpectralAll_restartMPI/test.py
except:
- master
- release
Plasticity_DetectChanges:
stage: spectral
script: Plasticity_DetectChanges/test.py
@ -364,12 +373,12 @@ Phenopowerlaw_singleSlip:
- master
- release
#TextureComponents:
# stage: spectral
# script: TextureComponents/test.py
# except:
# - master
# - release
TextureComponents:
stage: spectral
script: TextureComponents/test.py
except:
- master
- release
###################################################################################################
@ -468,27 +477,24 @@ AbaqusStd:
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
- $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT abaqus
except:
- master
- release
only:
- development
Marc:
stage: createDocumentation
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
- $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT marc
except:
- master
- release
only:
- development
Spectral:
stage: createDocumentation
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
- $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT spectral
except:
- master
- release
only:
- development
##################################################################################################
backupData:

27
CMakeLists.txt
View File

@ -445,6 +445,33 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
# Additional options
# -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4)
###################################################################################################
# PGI Compiler
###################################################################################################
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI")
if (OPTIMIZATION STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0" )
elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2")
elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-O3")
endif ()
#------------------------------------------------------------------------------------------------
# Fine tuning compilation options
set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess")
# preprocessor
set (STANDARD_CHECK "-Mallocatable=03")
#------------------------------------------------------------------------------------------------
# Runtime debugging
set (DEBUG_FLAGS "${DEBUG_FLAGS} -g")
# Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line
else ()
message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
endif ()

2
LICENSE
View File

@ -1,4 +1,4 @@
Copyright 2011-18 Max-Planck-Institut für Eisenforschung GmbH
Copyright 2011-19 Max-Planck-Institut für Eisenforschung GmbH
DAMASK is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by

4
Makefile
View File

@ -7,11 +7,11 @@ all: spectral FEM processing
.PHONY: spectral
spectral: build/spectral
@(cd build/spectral;make --no-print-directory -ws all install;)
@(cd build/spectral;make -j4 --no-print-directory -ws all install;)
.PHONY: FEM
FEM: build/FEM
@(cd build/FEM; make --no-print-directory -ws all install;)
@(cd build/FEM; make -j4 --no-print-directory -ws all install;)
.PHONY: build/spectral
build/spectral:

2
PRIVATE

@ -1 +1 @@
Subproject commit b9a52a85cd65cc27a8e863302bd984abdcad1455
Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b

2
VERSION
View File

@ -1 +1 @@
v2.0.2-1236-g1ef82e35
v2.0.2-1689-g1a471bcd

4
env/DAMASK.csh vendored
View File

@ -64,7 +64,7 @@ endif
setenv DAMASK_NUM_THREADS $DAMASK_NUM_THREADS
if ( ! $?PYTHONPATH ) then
setenv PYTHONPATH $DAMASK_ROOT/lib
setenv PYTHONPATH $DAMASK_ROOT/python
else
setenv PYTHONPATH $DAMASK_ROOT/lib:$PYTHONPATH
setenv PYTHONPATH $DAMASK_ROOT/python:$PYTHONPATH
endif

2
env/DAMASK.sh vendored
View File

@ -95,7 +95,7 @@ if [ ! -z "$PS1" ]; then
fi
export DAMASK_NUM_THREADS
export PYTHONPATH=$DAMASK_ROOT/lib:$PYTHONPATH
export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH
for var in BASE STAT SOLVER PROCESSING FREE DAMASK_BIN BRANCH; do
unset "${var}"

2
env/DAMASK.zsh vendored
View File

@ -88,7 +88,7 @@ if [ ! -z "$PS1" ]; then
fi
export DAMASK_NUM_THREADS
export PYTHONPATH=$DAMASK_ROOT/lib:$PYTHONPATH
export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH
for var in BASE STAT SOLVER PROCESSING FREE DAMASK_BIN BRANCH; do
unset "${var}"

2
examples/ConfigFiles/Homogenization_None_Dummy.config
View File

@ -1,3 +1,3 @@
[directSX]
type none
mech none

4
examples/ConfigFiles/Phase_Isotropic_AluminumIsotropic.config
View File

@ -11,11 +11,11 @@ lattice_structure isotropic
c11 110.9e9
c12 58.34e9
taylorfactor 3
m 3
tau0 31e6
gdot0 0.001
n 20
h0 75e6
tausat 63e6
w0 2.25
a 2.25
atol_resistance 1

14
installation/mods_Abaqus/abaqus_v6.env
View File

@ -12,9 +12,17 @@
#
import os, re, glob, driverUtils
from damask import version as DAMASKVERSION
from damask import Environment
myEnv = Environment()
# Use the version in $PATH
fortCmd = "ifort"
if myEnv.options['DAMASK_HDF5'] == 'ON':
# use hdf5 compiler wrapper in $PATH
fortCmd = os.popen('h5fc -shlib -show').read().replace('\n','') # complicated way needed to pass in DAMASKVERSION string
link_sl += fortCmd.split()[1:]
fortCmd +=" -DDAMASKHDF5"
else:
# Use the version in $PATH
fortCmd = "ifort"
# -free to use free-format FORTRAN 90 syntax
# -O <0-3> optimization level
@ -50,4 +58,6 @@ ask_delete=OFF
# Remove the temporary names from the namespace
del fortCmd
del Environment
del myEnv
del DAMASKVERSION

14
installation/mods_Abaqus/abaqus_v6_debug.env
View File

@ -12,9 +12,17 @@
#
import os, re, glob, driverUtils
from damask import version as DAMASKVERSION
from damask import Environment
myEnv = Environment()
# Use the version in $PATH
fortCmd = "ifort"
if myEnv.options['DAMASK_HDF5'] == 'ON':
# use hdf5 compiler wrapper in $PATH
fortCmd = os.popen('h5fc -shlib -show').read().replace('\n','') # complicated way needed to pass in DAMASKVERSION string
link_sl += fortCmd.split()[1:]
fortCmd +=" -DDAMASKHDF5"
else:
# Use the version in $PATH
fortCmd = "ifort"
# -free to use free-format FORTRAN 90 syntax
# -O <0-3> optimization level
@ -55,4 +63,6 @@ ask_delete=OFF
# Remove the temporary names from the namespace
del fortCmd
del Environment
del myEnv
del DAMASKVERSION

31
installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64
View File

@ -63,7 +63,6 @@ else
INTEGER_PATH=/$MARC_INTEGER_SIZE
fi
FCOMP=ifort
INTELPATH="/opt/intel/compilers_and_libraries_2017/linux"
# find the root directory of the compiler installation:
@ -99,6 +98,16 @@ else
FCOMPROOT=
fi
# DAMASK uses the HDF5 compiler wrapper around the Intel compiler
if test "$DAMASK_HDF5" = "ON";then
H5FC="$(h5fc -shlib -show)"
HDF5_LIB=${H5FC//ifort/}
FCOMP="$H5FC -DDAMASKHDF5"
echo $FCOMP
else
FCOMP=ifort
fi
# AEM
if test "$MARCDLLOUTDIR" = ""; then
DLLOUTDIR="$MARC_LIB"
@ -535,23 +544,17 @@ else
DAMASKVERSION="'N/A'"
fi
if test "$DAMASK_HDF5" = "ON";then
DFCOMP="$(h5fc -show) -DDAMASKHDF5"
else
DFCOMP=$FCOMP
fi
#
# DAMASK compiler calls: additional flags are in line 2 OpenMP flags in line 3
DFORTLOWMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
$MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTRANMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
$MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTHIGHMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
$MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
@ -570,15 +573,15 @@ then
fi
# DAMASK compiler calls: additional flags are in line 2 OpenMP flags in line 3
DFORTLOWMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
$MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTRANMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
$MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTHIGHMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
$MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
@ -744,7 +747,7 @@ SECLIBS="-L$MARC_LIB -llapi"
SOLVERLIBS="${BCSSOLVERLIBS} ${VKISOLVERLIBS} ${CASISOLVERLIBS} ${MF2SOLVERLIBS} \
$MKLLIB -L$MARC_MKL -liomp5 \
$MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/kdtree2.a "
$MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/kdtree2.a $HDF5_LIB "
SOLVERLIBS_DLL=${SOLVERLIBS}
if test "$AEM_DLL" -eq 1

1
processing/post/addEuclideanDistance.py
View File

@ -149,7 +149,6 @@ for name in filenames:
errors = []
remarks = []
column = {}
if not 3 >= table.label_dimension(options.pos) >= 1:
errors.append('coordinates "{}" need to have one, two, or three dimensions.'.format(options.pos))

9
processing/post/addMises.py
View File

@ -4,6 +4,7 @@
import os,sys,math
import numpy as np
from optparse import OptionParser
from collections import OrderedDict
import damask
scriptName = os.path.splitext(os.path.basename(__file__))[0]
@ -63,10 +64,10 @@ for name in filenames:
# ------------------------------------------ sanity checks ----------------------------------------
items = {
'strain': {'dim': 9, 'shape': [3,3], 'labels':options.strain, 'active':[], 'column': []},
'stress': {'dim': 9, 'shape': [3,3], 'labels':options.stress, 'active':[], 'column': []},
}
items = OrderedDict([
('strain', {'dim': 9, 'shape': [3,3], 'labels':options.strain, 'active':[], 'column': []}),
('stress', {'dim': 9, 'shape': [3,3], 'labels':options.stress, 'active':[], 'column': []})
])
errors = []
remarks = []

142
processing/post/ascii2hdf5.py
View File

@ -1,142 +0,0 @@
#!/usr/bin/env python2.7
# -*- coding: UTF-8 no BOM -*-
# ------------------------------------------------------------------- #
# NOTE: #
# 1. Not all output is defined in the DS_HDF5.xml, please add new #
# new one to the system wide definition file #
# <DAMASK_ROOT>/lib/damask/DS_HDF5.xml #
# or specify your own when initializing HDF5 class #
# 2. Somehow the point cloud structure cannot be properly handled #
# by Xdmf, which is a descriptive wrapper for visualizing HDF5 #
# using Paraview. The current solution is using cell structured #
# HDF5 so that Xdmf can describe the data shape as a rectangular #
# mesh rather than polyvertex. #
# TODO: #
# 1. remove the <ASCII_TABLE>._tmp file, basically need a way to #
# just load data from ASCII table. #
# 2. a progress monitor when transferring data from ASCII table #
# to HDF5. #
# 3. a more flexible way handle the data structure rather than a #
# xml file. #
# ------------------------------------------------------------------- #
import os
import damask
import numpy as np
from optparse import OptionParser
scriptName = os.path.splitext(os.path.basename(__file__))[0]
scriptID = ' '.join([scriptName, damask.version])
# ----- helper function ----- #
def get_rectMshVectors(xyz_array, posNum):
"""Get Vx, Vy, Vz for rectLinear grid"""
# need some improvement, and only works for rectangular grid
v = sorted(list(set(xyz_array[:, posNum])))
v_interval = (v[2]+v[1])/2.0 - (v[1]+v[0])/2.0
v_start = (v[1]+v[0])/2.0 - v_interval
v_end = (v[-1]+v[-2])/2.0 + v_interval
V = np.linspace(v_start, v_end, len(v)+1)
return V
# ----- MAIN ---- #
desp_msg = "Convert DAMASK ascii table to HDF5 file"
parser = OptionParser(option_class=damask.extendableOption,
usage='%prog options [file[s]]',
description=desp_msg,
version=scriptID)
parser.add_option('-D', '--DefinitionFile',
dest='storage definition file',
type='string',
metavar='string',
help='definition file for H5 data storage')
parser.add_option('-p', '--pos', '--position',
dest='pos',
type='string', metavar='string',
help='label of coordinates [%default]')
parser.set_defaults(DefinitionFile='default',
pos='pos')
(options, filenames) = parser.parse_args()
filename = filenames[0]
if options.DefinitionFile == 'default':
defFile = None
else:
defFile = options.DefinitionFile
# ----- read in data using DAMASK ASCII table class ----- #
asciiTable = damask.ASCIItable(name=filename, buffered=False)
asciiTable.head_read()
asciiTable.data_readArray()
incNum = int(asciiTable.data[asciiTable.label_index('inc'), 0])
fullTable = np.copy(asciiTable.data) # deep copy all data, just to be safe
labels = asciiTable.labels()
labels_idx = [asciiTable.label_index(label) for label in labels]
featuresDim = [labels_idx[i+1] - labels_idx[i] for i in range(len(labels)-1)]
featuresDim.append(fullTable.shape[1] - labels_idx[-1])
# ----- figure out size and grid ----- #
pos_idx = asciiTable.label_index('pos')
xyz_array = asciiTable.data[:, pos_idx:pos_idx+3]
Vx = get_rectMshVectors(xyz_array, 0)
Vy = get_rectMshVectors(xyz_array, 1)
Vz = get_rectMshVectors(xyz_array, 2)
# use the dimension of the rectangular grid to reshape all other data
mshGridDim = [len(Vx)-1, len(Vy)-1, len(Vz)-1]
# ----- compose cmd log ----- #
cmd_log = " ".join([scriptID, filename])
# ----- create a new HDF5 file and save the data -----#
# force remove existing HDF5 file
h5fName = filename.replace(".txt", ".h5")
try:
os.remove(h5fName)
except OSError:
pass
h5f = damask.H5Table(h5fName,
new_file=True,
dsXMLFile=defFile)
# adding increment number as root level attributes
h5f.add_attr('inc', incNum)
# add the mesh grid data now
h5f.add_data("Vx", Vx, cmd_log=cmd_log)
h5f.add_data("Vy", Vy, cmd_log=cmd_log)
h5f.add_data("Vz", Vz, cmd_log=cmd_log)
# add the rest of data from table
labelsProcessed = ['inc']
for fi in range(len(labels)):
featureName = labels[fi]
# remove trouble maker "("" and ")" from label/feature name
if "(" in featureName:
featureName = featureName.replace("(", "")
if ")" in featureName:
featureName = featureName.replace(")", "")
# skip increment and duplicated columns in the ASCII table
if featureName in labelsProcessed:
continue
featureIdx = labels_idx[fi]
featureDim = featuresDim[fi]
# grab the data hook
dataset = fullTable[:, featureIdx:featureIdx+featureDim]
# mapping 2D data onto a 3D rectangular mesh to get 4D data
# WARNING: In paraview, the data for a recmesh is mapped as:
# --> len(z), len(y), len(x), size(data)
# dataset = dataset.reshape((mshGridDim[0],
# mshGridDim[1],
# mshGridDim[2],
# dataset.shape[1]))
# write out data
print("adding {}...".format(featureName))
h5f.add_data(featureName, dataset, cmd_log=cmd_log)
# write down the processed label
labelsProcessed.append(featureName)

44
processing/post/groupTable.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys
@ -21,18 +21,19 @@ scriptID = ' '.join([scriptName,damask.version])
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
Apply a user-specified function to condense all rows for which column 'label' has identical values into a single row.
Output table will contain as many rows as there are different (unique) values in the grouping column.
Apply a user-specified function to condense into a single row all those rows for which columns 'label' have identical values.
Output table will contain as many rows as there are different (unique) values in the grouping column(s).
Periodic domain averaging of coordinate values is supported.
Examples:
For grain averaged values, replace all rows of particular 'texture' with a single row containing their average.
""", version = scriptID)
{name} --label texture --function np.average data.txt
""".format(name = scriptName), version = scriptID)
parser.add_option('-l','--label',
dest = 'label',
type = 'string', metavar = 'string',
help = 'column label for grouping rows')
action = 'extend', metavar = '<string LIST>',
help = 'column label(s) for grouping rows')
parser.add_option('-f','--function',
dest = 'function',
type = 'string', metavar = 'string',
@ -40,7 +41,7 @@ parser.add_option('-f','--function',
parser.add_option('-a','--all',
dest = 'all',
action = 'store_true',
help = 'apply mapping function also to grouping column')
help = 'apply mapping function also to grouping column(s)')
group = OptionGroup(parser, "periodic averaging", "")
@ -57,6 +58,7 @@ parser.add_option_group(group)
parser.set_defaults(function = 'np.average',
all = False,
label = [],
boundary = [0.0, 1.0])
(options,filenames) = parser.parse_args()
@ -71,7 +73,7 @@ try:
except:
mapFunction = None
if options.label is None:
if options.label is []:
parser.error('no grouping column specified.')
if not hasattr(mapFunction,'__call__'):
parser.error('function "{}" is not callable.'.format(options.function))
@ -89,13 +91,20 @@ for name in filenames:
# ------------------------------------------ sanity checks ---------------------------------------
remarks = []
errors = []
table.head_read()
if table.label_dimension(options.label) != 1:
damask.util.croak('column {} is not of scalar dimension.'.format(options.label))
table.close(dismiss = True) # close ASCIItable and remove empty file
grpColumns = table.label_index(options.label)[::-1]
grpColumns = grpColumns[np.where(grpColumns>=0)]
if len(grpColumns) == 0: errors.append('no valid grouping column present.')
if remarks != []: damask.util.croak(remarks)
if errors != []:
damask.util.croak(errors)
table.close(dismiss=True)
continue
else:
grpColumn = table.label_index(options.label)
# ------------------------------------------ assemble info ---------------------------------------
@ -108,10 +117,9 @@ for name in filenames:
indexrange = table.label_indexrange(options.periodic) if options.periodic is not None else []
rows,cols = table.data.shape
table.data = table.data[np.lexsort([table.data[:,grpColumn]])] # sort data by grpColumn
values,index = np.unique(table.data[:,grpColumn], return_index = True) # unique grpColumn values and their positions
index = np.append(index,rows) # add termination position
table.data = table.data[np.lexsort(table.data[:,grpColumns].T)] # sort data by grpColumn(s)
values,index = np.unique(table.data[:,grpColumns], axis=0, return_index=True) # unique grpColumn values and their positions
index = sorted(np.append(index,rows)) # add termination position
grpTable = np.empty((len(values), cols)) # initialize output
for i in range(len(values)): # iterate over groups (unique values in grpColumn)
@ -119,7 +127,7 @@ for name in filenames:
grpTable[i,indexrange] = \
periodicAverage(table.data[index[i]:index[i+1],indexrange],options.boundary) # apply periodicAverage mapping function
if not options.all: grpTable[i,grpColumn] = table.data[index[i],grpColumn] # restore grouping column value
if not options.all: grpTable[i,grpColumns] = table.data[index[i],grpColumns] # restore grouping column value
table.data = grpTable

10
processing/post/postResults.py
View File

@ -831,7 +831,7 @@ if options.info:
elementsOfNode = {}
Nelems = stat['NumberOfElements']
for e in range(Nelems):
if options.verbose and Nelems > 100 and e%(Nelems//100) == 0: # report in 1% steps if possible and avoid modulo by zero
if options.verbose and Nelems >= 50 and e%(Nelems//50) == 0: # report in 2% steps if possible and avoid modulo by zero
damask.util.progressBar(iteration=e,total=Nelems,prefix='1/3: connecting elements')
for n in map(p.node_sequence,p.element(e).items):
if n not in elementsOfNode:
@ -856,7 +856,7 @@ damask.util.progressBar(iteration=1,total=1,prefix='1/3: connecting elements')
if options.nodalScalar:
Npoints = stat['NumberOfNodes']
for n in range(Npoints):
if options.verbose and Npoints > 100 and e%(Npoints//100) == 0: # report in 1% steps if possible and avoid modulo by zero
if options.verbose and Npoints >= 50 and e%(Npoints//50) == 0: # report in 2% steps if possible and avoid modulo by zero
damask.util.progressBar(iteration=n,total=Npoints,prefix='2/3: scanning nodes ')
myNodeID = p.node_id(n)
myNodeCoordinates = [p.node(n).x, p.node(n).y, p.node(n).z]
@ -893,7 +893,7 @@ if options.nodalScalar:
else:
Nelems = stat['NumberOfElements']
for e in range(Nelems):
if options.verbose and Nelems > 100 and e%(Nelems//100) == 0: # report in 1% steps if possible and avoid modulo by zero
if options.verbose and Nelems >= 50 and e%(Nelems//50) == 0: # report in 2% steps if possible and avoid modulo by zero
damask.util.progressBar(iteration=e,total=Nelems,prefix='2/3: scanning elements ')
myElemID = p.element_id(e)
myIpCoordinates = ipCoords(p.element(e).type, list(map(lambda node: [node.x, node.y, node.z],
@ -1034,7 +1034,7 @@ for incCount,position in enumerate(locations): # walk through locations
Ngroups = len(groups)
for j,group in enumerate(groups):
f = incCount*Ngroups + j
if options.verbose and (Ngroups*Nincs) > 100 and f%((Ngroups*Nincs)//100) == 0: # report in 1% steps if possible and avoid modulo by zero
if options.verbose and (Ngroups*Nincs) >= 50 and f%((Ngroups*Nincs)//50) == 0: # report in 2% steps if possible and avoid modulo by zero
damask.util.progressBar(iteration=f,total=Ngroups*Nincs,prefix='3/3: processing points ')
N = 0 # group member counter
for (e,n,i,g,n_local) in group[1:]: # loop over group members
@ -1087,7 +1087,7 @@ for incCount,position in enumerate(locations): # walk through locations
['Crystallite']*len(options.crystalliteResult) +
['Constitutive']*len(options.constitutiveResult)
):
outputIndex = (list(zip(*outputFormat[resultType]['outputs']))[0]).index(label) # find the position of this output in the outputFormat
outputIndex = (list(zip(*outputFormat[resultType]['outputs']))[0]).index(label) # find the position of this output in the outputFormat
length = int(outputFormat[resultType]['outputs'][outputIndex][1])
thisHead = heading('_',[[component,''.join( label.split() )] for component in range(int(length>1),length+int(length>1))])
if assembleHeader: header += thisHead

9
processing/post/viewTable.py
View File

@ -61,7 +61,14 @@ for name in filenames:
table = damask.ASCIItable(name = name,
buffered = False, labeled = options.labeled, readonly = True)
except: continue
damask.util.report(scriptName,name)
details = ', '.join(
(['header'] if options.table else []) +
(['info'] if options.head or options.info else []) +
(['labels'] if options.head or options.labels else []) +
(['data'] if options.data else []) +
[]
)
damask.util.report(scriptName,(name if name is not None else '') + ('' if details == '' else ' -- '+details))
# ------------------------------------------ output head ---------------------------------------

185
processing/pre/geom_fromVPSC.py
View File

@ -1,185 +0,0 @@
#!/usr/bin/env python2.7
# -*- coding: UTF-8 no BOM -*-
import os,sys,math
import numpy as np
from optparse import OptionParser
import damask
scriptName = os.path.splitext(os.path.basename(__file__))[0]
scriptID = ' '.join([scriptName,damask.version])
#--------------------------------------------------------------------------------------------------
# MAIN
#--------------------------------------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
Generate geometry description and material configuration from input files used by R.A. Lebensohn.
""", version = scriptID)
parser.add_option('--column', dest='column', type='int', metavar = 'int',
help='data column to discriminate between both phases [%default]')
parser.add_option('-t','--threshold', dest='threshold', type='float', metavar = 'float',
help='threshold value for phase discrimination [%default]')
parser.add_option('--homogenization', dest='homogenization', type='int', metavar = 'int',
help='homogenization index for <microstructure> configuration [%default]')
parser.add_option('--phase', dest='phase', type='int', nargs = 2, metavar = 'int int',
help='phase indices for <microstructure> configuration %default')
parser.add_option('--crystallite', dest='crystallite', type='int', metavar = 'int',
help='crystallite index for <microstructure> configuration [%default]')
parser.add_option('--compress', dest='compress', action='store_true',
help='lump identical microstructure and texture information [%default]')
parser.add_option('-p', '--precision', dest='precision', choices=['0','1','2','3'], metavar = 'int',
help = 'euler angles decimal places for output format and compressing {0,1,2,3} [2]')
parser.set_defaults(column = 7)
parser.set_defaults(threshold = 1.0)
parser.set_defaults(homogenization = 1)
parser.set_defaults(phase = [1,2])
parser.set_defaults(crystallite = 1)
parser.set_defaults(config = False)
parser.set_defaults(compress = False)
parser.set_defaults(precision = '2')
(options,filenames) = parser.parse_args()
if filenames == []: filenames = [None]
for name in filenames:
try:
table = damask.ASCIItable(name = name,
outname = os.path.splitext(name)[-2]+'.geom' if name else name,
buffered = False,
labeled = False)
except: continue
damask.util.report(scriptName,name)
info = {
'grid': np.zeros(3,'i'),
'size': np.zeros(3,'d'),
'origin': np.zeros(3,'d'),
'microstructures': 0,
'homogenization': options.homogenization
}
coords = [{},{},{}]
pos = {'min':[ float("inf"), float("inf"), float("inf")],
'max':[-float("inf"),-float("inf"),-float("inf")]}
phase = []
eulerangles = []
outputAlive = True
# ------------------------------------------ process data ------------------------------------------
while outputAlive and table.data_read():
if table.data != []:
currPos = table.data[3:6]
for i in range(3):
coords[i][currPos[i]] = True
currPos = map(float,currPos)
for i in range(3):
pos['min'][i] = min(pos['min'][i],currPos[i])
pos['max'][i] = max(pos['max'][i],currPos[i])
eulerangles.append(map(math.degrees,map(float,table.data[:3])))
phase.append(options.phase[int(float(table.data[options.column-1]) > options.threshold)])
# --------------- determine size and grid ---------------------------------------------------------
info['grid'] = np.array(map(len,coords),'i')
info['size'] = info['grid']/np.maximum(np.ones(3,'d'),info['grid']-1.0)* \
np.array([pos['max'][0]-pos['min'][0],
pos['max'][1]-pos['min'][1],
pos['max'][2]-pos['min'][2]],'d')
eulerangles = np.array(eulerangles,dtype='f').reshape(info['grid'].prod(),3)
phase = np.array(phase,dtype='i').reshape(info['grid'].prod())
limits = [360,180,360]
if any([np.any(eulerangles[:,i]>=limits[i]) for i in [0,1,2]]):
damask.util.croak.write('Error: euler angles out of bound. Ang file might contain unidexed poins.\n')
for i,angle in enumerate(['phi1','PHI','phi2']):
for n in np.nditer(np.where(eulerangles[:,i]>=limits[i]),['zerosize_ok']):
damask.util.croak.write('%s in line %i (%4.2f %4.2f %4.2f)\n'
%(angle,n,eulerangles[n,0],eulerangles[n,1],eulerangles[n,2]))
continue
eulerangles=np.around(eulerangles,int(options.precision)) # round to desired precision
# ensure, that rounded euler angles are not out of bounds (modulo by limits)
for i,angle in enumerate(['phi1','PHI','phi2']):
eulerangles[:,i]%=limits[i]
# scale angles by desired precision and convert to int. create unique integer key from three euler angles by
# concatenating the string representation with leading zeros and store as integer and search unique euler angle keys.
# Texture IDs are the indices of the first occurrence, the inverse is used to construct the microstructure
# create a microstructure (texture/phase pair) for each point using unique texture IDs.
# Use longInt (64bit, i8) because the keys might be long
if options.compress:
formatString='{0:0>'+str(int(options.precision)+3)+'}'
euleranglesRadInt = (eulerangles*10**int(options.precision)).astype('int')
eulerKeys = np.array([int(''.join(map(formatString.format,euleranglesRadInt[i,:]))) \
for i in range(info['grid'].prod())])
devNull, texture, eulerKeys_idx = np.unique(eulerKeys, return_index = True, return_inverse=True)
msFull = np.array([[eulerKeys_idx[i],phase[i]] for i in range(info['grid'].prod())],'i8')
devNull,msUnique,matPoints = np.unique(msFull.view('c16'),True,True)
matPoints+=1
microstructure = np.array([msFull[i] for i in msUnique]) # pick only unique microstructures
else:
texture = np.arange(info['grid'].prod())
microstructure = np.hstack( zip(texture,phase) ).reshape(info['grid'].prod(),2) # create texture/phase pairs
formatOut = 1+int(math.log10(len(texture)))
config_header = []
formatwidth = 1+int(math.log10(len(microstructure)))
config_header += ['<microstructure>']
for i in range(len(microstructure)):
config_header += ['[Grain%s]'%str(i+1).zfill(formatwidth),
'crystallite\t%i'%options.crystallite,
'(constituent)\tphase %i\ttexture %i\tfraction 1.0'%(microstructure[i,1],microstructure[i,0]+1)
]
config_header += ['<texture>']
eulerFormatOut='%%%i.%if'%(int(options.precision)+4,int(options.precision))
outStringAngles='(gauss) phi1 '+eulerFormatOut+' Phi '+eulerFormatOut+' phi2 '+eulerFormatOut+' scatter 0.0 fraction 1.0'
for i in range(len(texture)):
config_header += ['[Texture%s]'%str(i+1).zfill(formatOut),
outStringAngles%tuple(eulerangles[texture[i],...])
]
table.labels_clear()
table.info_clear()
info['microstructures'] = len(microstructure)
#--- report ---------------------------------------------------------------------------------------
damask.util.croak('grid a b c: %s\n'%(' x '.join(map(str,info['grid']))) +
'size x y z: %s\n'%(' x '.join(map(str,info['size']))) +
'origin x y z: %s\n'%(' : '.join(map(str,info['origin']))) +
'homogenization: %i\n'%info['homogenization'] +
'microstructures: %i\n\n'%info['microstructures'])
if np.any(info['grid'] < 1):
damask.util.croak('invalid grid a b c.\n')
continue
if np.any(info['size'] <= 0.0):
damask.util.croak('invalid size x y z.\n')
continue
#--- write data -----------------------------------------------------------------------------------
table.info_append([' '.join([scriptID] + sys.argv[1:]),
"grid\ta %i\tb %i\tc %i"%(info['grid'][0],info['grid'][1],info['grid'][2],),
"size\tx %f\ty %f\tz %f"%(info['size'][0],info['size'][1],info['size'][2],),
"origin\tx %f\ty %f\tz %f"%(info['origin'][0],info['origin'][1],info['origin'][2],),
"microstructures\t%i"%info['microstructures'],
"homogenization\t%i"%info['homogenization'],
config_header
])
table.head_write()
if options.compress:
table.data = matPoints.reshape(info['grid'][1]*info['grid'][2],info['grid'][0])
table.data_writeArray('%%%ii'%(formatwidth),delimiter=' ')
else:
table.data = ["1 to %i\n"%(info['microstructures'])]
# ------------------------------------------ output finalization -----------------------------------
table.close()

4
processing/pre/mentat_pbcOnBoxMesh.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import sys,os,re,time,tempfile
@ -93,7 +93,7 @@ def add_servoLinks(mfd_data,active=[True,True,True]): # directions on which to
for i in range(len(mfd_data)):
mfd_dict[mfd_data[i]['label']] = i
NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][0::4])[:,1:4]
NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][1::4])[:,1:4]
Nnodes = NodeCoords.shape[0]
box['min'] = NodeCoords.min(axis=0) # find the bounding box

2
processing/pre/mentat_spectralBox.py
View File

@ -49,7 +49,7 @@ def output(cmds,locals,dest):
#-------------------------------------------------------------------------------------------------
def init():
return [
"#"+' '.join([scriptID] + sys.argv[1:]),
"|"+' '.join([scriptID] + sys.argv[1:]),
"*draw_manual", # prevent redrawing in Mentat, should be much faster
"*new_model yes",
"*reset",

0
lib/damask/.gitignore → python/damask/.gitignore vendored
View File

0
lib/damask/__init__.py → python/damask/__init__.py
View File

0
lib/damask/asciitable.py → python/damask/asciitable.py
View File

0
lib/damask/colormaps.py → python/damask/colormaps.py
View File

0
lib/damask/config/__init__.py → python/damask/config/__init__.py
View File

0
lib/damask/config/material.py → python/damask/config/material.py
View File

0
lib/damask/environment.py → python/damask/environment.py
View File

0
lib/damask/geometry/__init__.py → python/damask/geometry/__init__.py
View File

0
lib/damask/geometry/geometry.py → python/damask/geometry/geometry.py
View File

0
lib/damask/geometry/marc.py → python/damask/geometry/marc.py
View File

0
lib/damask/geometry/spectral.py → python/damask/geometry/spectral.py
View File

0
lib/damask/orientation.py → python/damask/orientation.py
View File

0
lib/damask/result.py → python/damask/result.py
View File

0
lib/damask/result/marc2vtk.py → python/damask/result/marc2vtk.py
View File

0
lib/damask/solver/__init__.py → python/damask/solver/__init__.py
View File

0
lib/damask/solver/abaqus.py → python/damask/solver/abaqus.py
View File

0
lib/damask/solver/marc.py → python/damask/solver/marc.py
View File

0
lib/damask/solver/solver.py → python/damask/solver/solver.py
View File

0
lib/damask/solver/spectral.py → python/damask/solver/spectral.py
View File

0
lib/damask/test/__init__.py → python/damask/test/__init__.py
View File

0
lib/damask/test/test.py → python/damask/test/test.py
View File

29
lib/damask/util.py → python/damask/util.py
View File

@ -134,7 +134,7 @@ class extendableOption(Option):
# Print iterations progress
# from https://gist.github.com/aubricus/f91fb55dc6ba5557fbab06119420dd6a
def progressBar(iteration, total, prefix='', suffix='', decimals=1, bar_length=100):
def progressBar(iteration, total, prefix='', bar_length=50):
"""
Call in a loop to create terminal progress bar
@ -142,16 +142,29 @@ def progressBar(iteration, total, prefix='', suffix='', decimals=1, bar_length=1
iteration - Required : current iteration (Int)
total - Required : total iterations (Int)
prefix - Optional : prefix string (Str)
suffix - Optional : suffix string (Str)
decimals - Optional : positive number of decimals in percent complete (Int)
bar_length - Optional : character length of bar (Int)
"""
str_format = "{0:." + str(decimals) + "f}"
percents = str_format.format(100 * (iteration / float(total)))
filled_length = int(round(bar_length * iteration / float(total)))
bar = '█' * filled_length + '-' * (bar_length - filled_length)
fraction = iteration / float(total)
if not hasattr(progressBar, "last_fraction"): # first call to function
progressBar.start_time = time.time()
progressBar.last_fraction = -1.0
remaining_time = ' n/a'
else:
if fraction <= progressBar.last_fraction or iteration == 0: # reset: called within a new loop
progressBar.start_time = time.time()
progressBar.last_fraction = -1.0
remaining_time = ' n/a'
else:
progressBar.last_fraction = fraction
remainder = (total - iteration) * (time.time()-progressBar.start_time)/iteration
remaining_time = '{: 3d}:'.format(int( remainder//3600)) + \
'{:02d}:'.format(int((remainder//60)%60)) + \
'{:02d}' .format(int( remainder %60))
sys.stderr.write('\r%s |%s| %s%s %s' % (prefix, bar, percents, '%', suffix)),
filled_length = int(round(bar_length * fraction))
bar = '█' * filled_length + '░' * (bar_length - filled_length)
sys.stderr.write('\r{} {} {}'.format(prefix, bar, remaining_time)),
if iteration == total: sys.stderr.write('\n\n')
sys.stderr.flush()

54
src/CMakeLists.txt
View File

@ -29,24 +29,28 @@ add_library(IO OBJECT "IO.f90")
add_dependencies(IO DAMASK_INTERFACE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:IO>)
add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90")
add_dependencies(HDF5_UTILITIES IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:HDF5_UTILITIES>)
add_library(NUMERICS OBJECT "numerics.f90")
add_dependencies(NUMERICS HDF5_UTILITIES)
add_dependencies(NUMERICS IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:NUMERICS>)
add_library(DEBUG OBJECT "debug.f90")
add_dependencies(DEBUG NUMERICS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DEBUG>)
add_library(CONFIG OBJECT "config.f90")
add_dependencies(CONFIG DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:CONFIG>)
add_library(DAMASK_CONFIG OBJECT "config.f90")
add_dependencies(DAMASK_CONFIG DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_CONFIG>)
add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90")
add_dependencies(HDF5_UTILITIES DAMASK_CONFIG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:HDF5_UTILITIES>)
add_library(RESULTS OBJECT "results.f90")
add_dependencies(RESULTS HDF5_UTILITIES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:RESULTS>)
add_library(FEsolving OBJECT "FEsolving.f90")
add_dependencies(FEsolving DEBUG)
add_dependencies(FEsolving RESULTS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEsolving>)
add_library(DAMASK_MATH OBJECT "math.f90")
@ -68,7 +72,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
endif()
add_library(MATERIAL OBJECT "material.f90")
add_dependencies(MATERIAL MESH CONFIG)
add_dependencies(MATERIAL MESH DAMASK_CONFIG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MATERIAL>)
add_library(DAMASK_HELPERS OBJECT "lattice.f90")
@ -90,9 +94,7 @@ list(APPEND OBJECTFILES $<TARGET_OBJECTS:PLASTIC>)
add_library (KINEMATICS OBJECT
"kinematics_cleavage_opening.f90"
"kinematics_slipplane_opening.f90"
"kinematics_thermal_expansion.f90"
"kinematics_vacancy_strain.f90"
"kinematics_hydrogen_strain.f90")
"kinematics_thermal_expansion.f90")
add_dependencies(KINEMATICS DAMASK_HELPERS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:KINEMATICS>)
@ -102,10 +104,7 @@ add_library (SOURCE OBJECT
"source_damage_isoBrittle.f90"
"source_damage_isoDuctile.f90"
"source_damage_anisoBrittle.f90"
"source_damage_anisoDuctile.f90"
"source_vacancy_phenoplasticity.f90"
"source_vacancy_irradiation.f90"
"source_vacancy_thermalfluc.f90")
"source_damage_anisoDuctile.f90")
add_dependencies(SOURCE DAMASK_HELPERS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SOURCE>)
@ -124,25 +123,6 @@ add_library(HOMOGENIZATION OBJECT
add_dependencies(HOMOGENIZATION CRYSTALLITE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:HOMOGENIZATION>)
add_library(HYDROGENFLUX OBJECT
"hydrogenflux_isoconc.f90"
"hydrogenflux_cahnhilliard.f90")
add_dependencies(HYDROGENFLUX CRYSTALLITE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:HYDROGENFLUX>)
add_library(POROSITY OBJECT
"porosity_none.f90"
"porosity_phasefield.f90")
add_dependencies(POROSITY CRYSTALLITE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:POROSITY>)
add_library(VACANCYFLUX OBJECT
"vacancyflux_isoconc.f90"
"vacancyflux_isochempot.f90"
"vacancyflux_cahnhilliard.f90")
add_dependencies(VACANCYFLUX CRYSTALLITE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:VACANCYFLUX>)
add_library(DAMAGE OBJECT
"damage_none.f90"
"damage_local.f90"
@ -158,7 +138,7 @@ add_dependencies(THERMAL CRYSTALLITE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:THERMAL>)
add_library(DAMASK_ENGINE OBJECT "homogenization.f90")
add_dependencies(DAMASK_ENGINE THERMAL DAMAGE VACANCYFLUX POROSITY HYDROGENFLUX HOMOGENIZATION)
add_dependencies(DAMASK_ENGINE THERMAL DAMAGE HOMOGENIZATION)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_ENGINE>)
add_library(DAMASK_CPFE OBJECT "CPFEM2.f90")

56
src/CPFEM.f90
View File

@ -155,7 +155,6 @@ subroutine CPFEM_init
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_dPdF0, &
crystallite_Tstar0_v
implicit none
@ -207,9 +206,6 @@ subroutine CPFEM_init
read (777,rec=1) crystallite_Li0
close (777)
call IO_read_realFile(777,'convergeddPdF'//trim(rankStr),modelName,size(crystallite_dPdF0))
read (777,rec=1) crystallite_dPdF0
close (777)
call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v))
read (777,rec=1) crystallite_Tstar0_v
@ -286,12 +282,11 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
math_identity2nd, &
math_mul33x33, &
math_det33, &
math_transpose33, &
math_I3, &
math_Mandel3333to66, &
math_Mandel66to3333, &
math_Mandel33to6, &
math_Mandel6to33
math_delta, &
math_sym3333to66, &
math_66toSym3333, &
math_sym33to6, &
math_6toSym33
use mesh, only: &
mesh_FEasCP, &
mesh_NcpElems, &
@ -304,8 +299,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
hydrogenfluxState, &
phaseAt, phasememberAt, &
material_phase, &
phase_plasticity, &
@ -328,7 +321,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF0, &
crystallite_dPdF, &
crystallite_Tstar0_v, &
crystallite_Tstar_v
@ -355,8 +347,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
integer(pInt), intent(in) :: mode !< computation mode 1: regular computation plus aging of results
real(pReal), intent(in) :: temperature_inp !< temperature
logical, intent(in) :: parallelExecution !< flag indicating parallel computation of requested IPs
real(pReal), dimension(6), intent(out) :: cauchyStress !< stress vector in Mandel notation
real(pReal), dimension(6,6), intent(out) :: jacobian !< jacobian in Mandel notation (Consistent tangent dcs/dE)
real(pReal), dimension(6), intent(out) :: cauchyStress !< stress as 6 vector
real(pReal), dimension(6,6), intent(out) :: jacobian !< jacobian as 66 tensor (Consistent tangent dcs/dE)
real(pReal) J_inverse, & ! inverse of Jacobian
rnd
@ -400,7 +392,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity
crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation
crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity
crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness
crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress
forall ( i = 1:size(plasticState )) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array
@ -421,8 +412,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state
damageState (homog)%state0 = damageState (homog)%state
vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state
hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state
enddo
@ -458,10 +447,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
write (777,rec=1) crystallite_Li0
close (777)
call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0))
write (777,rec=1) crystallite_dPdF0
close (777)
call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v))
write (777,rec=1) crystallite_Tstar0_v
close (777)
@ -538,8 +523,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
write(6,'(a,1x,i8,1x,i2)') '<< CPFEM >> OUTDATED at elFE ip',elFE,ip
write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 old:',&
math_transpose33(materialpoint_F(1:3,1:3,ip,elCP))
write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 now:',math_transpose33(ffn1)
transpose(materialpoint_F(1:3,1:3,ip,elCP))
write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 now:',transpose(ffn1)
endif
outdatedFFN1 = .true.
endif
@ -597,26 +582,25 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
endif
! translate from P to CS
Kirchhoff = math_mul33x33(materialpoint_P(1:3,1:3,ip,elCP), math_transpose33(materialpoint_F(1:3,1:3,ip,elCP)))
Kirchhoff = math_mul33x33(materialpoint_P(1:3,1:3,ip,elCP), transpose(materialpoint_F(1:3,1:3,ip,elCP)))
J_inverse = 1.0_pReal / math_det33(materialpoint_F(1:3,1:3,ip,elCP))
CPFEM_cs(1:6,ip,elCP) = math_Mandel33to6(J_inverse * Kirchhoff)
CPFEM_cs(1:6,ip,elCP) = math_sym33to6(J_inverse * Kirchhoff,weighted=.false.)
! translate from dP/dF to dCS/dE
H = 0.0_pReal
do i=1,3; do j=1,3; do k=1,3; do l=1,3; do m=1,3; do n=1,3
H(i,j,k,l) = H(i,j,k,l) + &
materialpoint_F(j,m,ip,elCP) * &
materialpoint_F(l,n,ip,elCP) * &
materialpoint_dPdF(i,m,k,n,ip,elCP) - &
math_I3(j,l) * materialpoint_F(i,m,ip,elCP) * materialpoint_P(k,m,ip,elCP) + &
0.5_pReal * (math_I3(i,k) * Kirchhoff(j,l) + math_I3(j,l) * Kirchhoff(i,k) + &
math_I3(i,l) * Kirchhoff(j,k) + math_I3(j,k) * Kirchhoff(i,l))
H(i,j,k,l) = H(i,j,k,l) &
+ materialpoint_F(j,m,ip,elCP) * materialpoint_F(l,n,ip,elCP) &
* materialpoint_dPdF(i,m,k,n,ip,elCP) &
- math_delta(j,l) * materialpoint_F(i,m,ip,elCP) * materialpoint_P(k,m,ip,elCP) &
+ 0.5_pReal * ( Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
+ Kirchhoff(j,k)*math_delta(i,l) + Kirchhoff(i,l)*math_delta(j,k))
enddo; enddo; enddo; enddo; enddo; enddo
forall(i=1:3, j=1:3,k=1:3,l=1:3) &
H_sym(i,j,k,l) = 0.25_pReal * (H(i,j,k,l) + H(j,i,k,l) + H(i,j,l,k) + H(j,i,l,k))
CPFEM_dcsde(1:6,1:6,ip,elCP) = math_Mandel3333to66(J_inverse * H_sym)
CPFEM_dcsde(1:6,1:6,ip,elCP) = math_sym3333to66(J_inverse * H_sym,weighted=.false.)
endif terminalIllness
endif validCalculation
@ -643,7 +627,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
!*** remember extreme values of stress ...
cauchyStress33 = math_Mandel6to33(CPFEM_cs(1:6,ip,elCP))
cauchyStress33 = math_6toSym33(CPFEM_cs(1:6,ip,elCP),weighted=.false.)
if (maxval(cauchyStress33) > debug_stressMax) then
debug_stressMaxLocation = [elCP, ip]
debug_stressMax = maxval(cauchyStress33)
@ -653,7 +637,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
debug_stressMin = minval(cauchyStress33)
endif
!*** ... and Jacobian
jacobian3333 = math_Mandel66to3333(CPFEM_dcsdE(1:6,1:6,ip,elCP))
jacobian3333 = math_66toSym3333(CPFEM_dcsdE(1:6,1:6,ip,elCP),weighted=.false.)
if (maxval(jacobian3333) > debug_jacobianMax) then
debug_jacobianMaxLocation = [elCP, ip]
debug_jacobianMax = maxval(jacobian3333)

206
src/CPFEM2.f90
View File

@ -10,8 +10,8 @@ module CPFEM2
public :: &
CPFEM_age, &
CPFEM_initAll
CPFEM_initAll, &
CPFEM_results
contains
@ -20,8 +20,7 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll()
use prec, only: &
pInt
use prec, only: &
pInt, &
prec_init
use numerics, only: &
numerics_init
@ -39,6 +38,8 @@ subroutine CPFEM_initAll()
material_init
use HDF5_utilities, only: &
HDF5_utilities_init
use results, only: &
results_init
use lattice, only: &
lattice_init
use constitutive, only: &
@ -73,6 +74,7 @@ subroutine CPFEM_initAll()
call lattice_init
call material_init
call HDF5_utilities_init
call results_init
call constitutive_init
call crystallite_init
call homogenization_init
@ -105,8 +107,7 @@ subroutine CPFEM_init
debug_levelBasic, &
debug_levelExtensive
use FEsolving, only: &
restartRead, &
modelName
restartRead
use material, only: &
material_phase, &
homogState, &
@ -120,28 +121,26 @@ subroutine CPFEM_init
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_dPdF0, &
crystallite_Tstar0_v
use hdf5
use HDF5_utilities, only: &
HDF5_openFile, &
HDF5_openGroup2, &
HDF5_closeFile, &
HDF5_openGroup, &
HDF5_closeGroup, &
HDF5_read
use DAMASK_interface, only: &
getSolverJobName
implicit none
integer(pInt) :: k,l,m,ph,homog
integer(pInt) :: ph,homog
character(len=1024) :: rankStr, PlasticItem, HomogItem
integer(HID_T) :: fileReadID, groupPlasticID, groupHomogID
integer :: hdferr
integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
flush(6)
endif mainProcess
flush(6)
! *** restore the last converged values of each essential variable from the binary file
if (restartRead) then
@ -152,34 +151,38 @@ subroutine CPFEM_init
write(rankStr,'(a1,i0)')'_',worldrank
fileReadID = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5')
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5')
call HDF5_read(material_phase, fileReadID,'recordedPhase')
call HDF5_read(crystallite_F0, fileReadID,'convergedF')
call HDF5_read(crystallite_Fp0, fileReadID,'convergedFp')
call HDF5_read(crystallite_Fi0, fileReadID,'convergedFi')
call HDF5_read(crystallite_Lp0, fileReadID,'convergedLp')
call HDF5_read(crystallite_Li0, fileReadID,'convergedLi')
call HDF5_read(crystallite_dPdF0, fileReadID,'convergeddPdF')
call HDF5_read(crystallite_Tstar0_v,fileReadID,'convergedTstar')
call HDF5_read(fileHandle,material_phase, 'recordedPhase')
call HDF5_read(fileHandle,crystallite_F0, 'convergedF')
call HDF5_read(fileHandle,crystallite_Fp0, 'convergedFp')
call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi')
call HDF5_read(fileHandle,crystallite_Lp0, 'convergedLp')
call HDF5_read(fileHandle,crystallite_Li0, 'convergedLi')
call HDF5_read(fileHandle,crystallite_Tstar0_v,'convergedTstar')
groupPlasticID = HDF5_openGroup2(fileReadID,'PlasticPhases')
groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
do ph = 1_pInt,size(phase_plasticity)
write(PlasticItem,*) ph,'_'
call HDF5_read(plasticState(ph)%state0,groupPlasticID,trim(PlasticItem)//'convergedStateConst')
call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
enddo
call HDF5_closeGroup(groupPlasticID)
groupHomogID = HDF5_openGroup2(fileReadID,'HomogStates')
groupHomogID = HDF5_openGroup(fileHandle,'HomogStates')
do homog = 1_pInt, material_Nhomogenization
write(HomogItem,*) homog,'_'
call HDF5_read(homogState(homog)%state0, groupHomogID,trim(HomogItem)//'convergedStateHomog')
call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog')
enddo
call HDF5_closeGroup(groupHomogID)
call HDF5_closeFile(fileHandle)
restartRead = .false.
endif
end subroutine CPFEM_init
!--------------------------------------------------------------------------------------------------
!> @brief forwards data after successful increment
!--------------------------------------------------------------------------------------------------
@ -203,8 +206,6 @@ subroutine CPFEM_age()
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
hydrogenfluxState, &
material_phase, &
phase_plasticity, &
phase_Nsources
@ -221,7 +222,6 @@ subroutine CPFEM_age()
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF0, &
crystallite_dPdF, &
crystallite_Tstar0_v, &
crystallite_Tstar_v
@ -231,84 +231,100 @@ subroutine CPFEM_age()
use HDF5_utilities, only: &
HDF5_openFile, &
HDF5_closeFile, &
HDF5_addGroup, &
HDF5_closeGroup, &
HDF5_addGroup2, &
HDF5_write
use hdf5
use DAMASK_interface, only: &
getSolverJobName
implicit none
integer(pInt) :: i, k, l, m, ph, homog, mySource
integer(pInt) :: i, ph, homog, mySource
character(len=32) :: rankStr, PlasticItem, HomogItem
integer(HID_T) :: fileHandle, groupPlastic, groupHomog
integer :: hdferr
integer(HSIZE_T) :: hdfsize
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> aging states'
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> aging states'
crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...)
crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation
crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity
crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation
crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity
crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness
crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress
forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
do i = 1, size(sourceState)
do mySource = 1,phase_Nsources(i)
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
enddo; enddo
do homog = 1_pInt, material_Nhomogenization
homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state
damageState (homog)%state0 = damageState (homog)%state
vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state
hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state
enddo
crystallite_F0 = crystallite_partionedF
crystallite_Fp0 = crystallite_Fp
crystallite_Lp0 = crystallite_Lp
crystallite_Fi0 = crystallite_Fi
crystallite_Li0 = crystallite_Li
crystallite_Tstar0_v = crystallite_Tstar_v
forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
do i = 1, size(sourceState)
do mySource = 1,phase_Nsources(i)
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
enddo; enddo
do homog = 1_pInt, material_Nhomogenization
homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state
damageState (homog)%state0 = damageState (homog)%state
enddo
if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
write(rankStr,'(a1,i0)')'_',worldrank
if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
write(rankStr,'(a1,i0)')'_',worldrank
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','w')
call HDF5_write(fileHandle,material_phase, 'recordedPhase')
call HDF5_write(fileHandle,crystallite_F0, 'convergedF')
call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp')
call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi')
call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp')
call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi')
call HDF5_write(fileHandle,crystallite_Tstar0_v,'convergedTstar')
groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
do ph = 1_pInt,size(phase_plasticity)
write(PlasticItem,*) ph,'_'
call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
enddo
call HDF5_closeGroup(groupPlastic)
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','w')
call HDF5_write(material_phase, fileHandle,'recordedPhase')
call HDF5_write(crystallite_F0, fileHandle,'convergedF')
call HDF5_write(crystallite_Fp0, fileHandle,'convergedFp')
call HDF5_write(crystallite_Fi0, fileHandle,'convergedFi')
call HDF5_write(crystallite_Lp0, fileHandle,'convergedLp')
call HDF5_write(crystallite_Li0, fileHandle,'convergedLi')
call HDF5_write(crystallite_dPdF0, fileHandle,'convergeddPdF')
call HDF5_write(crystallite_Tstar0_v,fileHandle,'convergedTstar')
groupPlastic = HDF5_addGroup2(fileHandle,'PlasticPhases')
do ph = 1_pInt,size(phase_plasticity)
write(PlasticItem,*) ph,'_'
call HDF5_write(plasticState(ph)%state0,groupPlastic,trim(PlasticItem)//'convergedStateConst')
enddo
call HDF5_closeGroup(groupPlastic)
groupHomog = HDF5_addGroup(fileHandle,'HomogStates')
do homog = 1_pInt, material_Nhomogenization
write(HomogItem,*) homog,'_'
call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog')
enddo
call HDF5_closeGroup(groupHomog)
call HDF5_closeFile(fileHandle)
restartWrite = .false.
endif
groupHomog = HDF5_addGroup2(fileHandle,'HomogStates')
do homog = 1_pInt, material_Nhomogenization
write(HomogItem,*) homog,'_'
call HDF5_write(homogState(homog)%state0,groupHomog,trim(HomogItem)//'convergedStateHomog')
enddo
call HDF5_closeGroup(groupHomog)
call HDF5_closeFile(fileHandle)
restartWrite = .false.
endif
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> done aging states'
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> done aging states'
end subroutine CPFEM_age
!--------------------------------------------------------------------------------------------------
!> @brief triggers writing of the results
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_results(inc,time)
use prec, only: &
pInt
use results
use HDF5_utilities
use constitutive, only: &
constitutive_results
implicit none
integer(pInt), intent(in) :: inc
real(pReal), intent(in) :: time
call results_openJobFile
call results_addIncrement(inc,time)
call constitutive_results()
call results_removeLink('current') ! ToDo: put this into closeJobFile
call results_closeJobFile
end subroutine CPFEM_results
end module CPFEM2

10
src/C_routines.c
View File

@ -6,9 +6,11 @@
#include <sys/stat.h>
#include <stdio.h>
#include <string.h>
#include <signal.h>
/* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */
int isdirectory_c(const char *dir){
struct stat statbuf;
if(stat(dir, &statbuf) != 0) /* error */
@ -44,3 +46,11 @@ void gethostname_c(char hostname[], int *stat){
int chdir_c(const char *dir){
return chdir(dir);
}
void signalusr1_c(void (*handler)(int)){
signal(SIGUSR1, handler);
}
void signalusr2_c(void (*handler)(int)){
signal(SIGUSR2, handler);
}

16
src/DAMASK_abaqus.f
View File

@ -102,8 +102,6 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
calcMode, &
terminallyIll, &
symmetricSolver
use math, only: &
invnrmMandel
use debug, only: &
debug_info, &
debug_reset, &
@ -305,9 +303,9 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
! ABAQUS implicit: 11, 22, 33, 12, 13, 23
! ABAQUS implicit: 11, 22, 33, 12
forall(i=1:ntens) ddsdde(1:ntens,i) = invnrmMandel(i)*ddsdde_h(1:ntens,i)*invnrmMandel(1:ntens)
stress(1:ntens) = stress_h(1:ntens)*invnrmMandel(1:ntens)
if(symmetricSolver) ddsdde(1:ntens,1:ntens) = 0.5_pReal*(ddsdde(1:ntens,1:ntens) + transpose(ddsdde(1:ntens,1:ntens)))
ddsdde = ddsdde_h(1:ntens,1:ntens)
stress = stress_h(1:ntens)
if(symmetricSolver) ddsdde = 0.5_pReal*(ddsdde + transpose(ddsdde))
if(ntens == 6) then
stress_h = stress
stress(5) = stress_h(6)
@ -322,8 +320,8 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
statev = materialpoint_results(1:min(nstatv,materialpoint_sizeResults),npt,mesh_FEasCP('elem', noel))
if ( terminallyIll ) pnewdt = 0.5_pReal ! force cutback directly ?
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
if (terminallyIll) pnewdt = 0.5_pReal ! force cutback directly ?
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
end subroutine UMAT
@ -331,12 +329,12 @@ end subroutine UMAT
!--------------------------------------------------------------------------------------------------
!> @brief calls the exit function of Abaqus/Standard
!--------------------------------------------------------------------------------------------------
subroutine quit(mpie_error)
subroutine quit(DAMASK_error)
use prec, only: &
pInt
implicit none
integer(pInt) :: mpie_error
integer(pInt) :: DAMASK_error
flush(6)
call xit

44
src/DAMASK_interface.f90
View File

@ -12,9 +12,9 @@
module DAMASK_interface
use prec, only: &
pInt
implicit none
private
logical, public, protected :: SIGUSR1,SIGUSR2
integer(pInt), public, protected :: &
interface_restartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: &
@ -42,6 +42,8 @@ contains
subroutine DAMASK_interface_init()
use, intrinsic :: &
iso_fortran_env
use :: &
iso_c_binding
#include <petsc/finclude/petscsys.h>
#if defined(__GFORTRAN__) && __GNUC__ < 5
===================================================================================================
@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
use PETScSys
use system_routines, only: &
signalusr1_C, &
signalusr2_C, &
getHostName, &
getCWD
@ -229,6 +233,12 @@ subroutine DAMASK_interface_init()
if (interface_restartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
call signalusr1_c(c_funloc(setSIGUSR1))
call signalusr2_c(c_funloc(setSIGUSR2))
SIGUSR1 = .false.
SIGUSR2 = .false.
end subroutine DAMASK_interface_init
@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b)
end function makeRelativePath
!--------------------------------------------------------------------------------------------------
!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1
!--------------------------------------------------------------------------------------------------
subroutine setSIGUSR1(signal) bind(C)
use :: iso_c_binding
implicit none
integer(C_INT), value :: signal
SIGUSR1 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR1'
end subroutine setSIGUSR1
!--------------------------------------------------------------------------------------------------
!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2
!--------------------------------------------------------------------------------------------------
subroutine setSIGUSR2(signal) bind(C)
use :: iso_c_binding
implicit none
integer(C_INT), value :: signal
SIGUSR2 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR2'
end subroutine setSIGUSR2
!--------------------------------------------------------------------------------------------------
!> @brief taken from IO, check IO_stringValue for documentation
@ -469,11 +508,10 @@ pure function IIO_stringPos(string)
do while (verify(string(right+1:),SEP)>0)
left = right + verify(string(right+1:),SEP)
right = left + scan(string(left:),SEP) - 2
if ( string(left:left) == '#' ) exit
IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
enddo
end function IIO_stringPos
end module
end module

11
src/DAMASK_marc.f90
View File

@ -127,9 +127,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
calcMode, &
terminallyIll, &
symmetricSolver
use math, only: &
math_transpose33,&
invnrmMandel
use debug, only: &
debug_level, &
debug_LEVELBASIC, &
@ -235,9 +232,9 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
write(6,'(a,i12)') ' Nodes: ', nnode
write(6,'(a,i1)') ' Deformation gradient: ', itel
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n:', &
math_transpose33(ffn)
transpose(ffn)
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n+1:', &
math_transpose33(ffn1)
transpose(ffn1)
endif
!$ defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc
@ -357,8 +354,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
! Marc: 11, 22, 33, 12, 23, 13
! Marc: 11, 22, 33, 12
forall(i=1:ngens) d(1:ngens,i) = invnrmMandel(i)*ddsdde(1:ngens,i)*invnrmMandel(1:ngens)
s(1:ndi+nshear) = stress(1:ndi+nshear)*invnrmMandel(1:ndi+nshear)
d = ddsdde(1:ngens,1:ngens)
s = stress(1:ndi+nshear)
g = 0.0_pReal
if(symmetricSolver) d = 0.5_pReal*(d+transpose(d))

9
src/DAMASK_spectral.f90
View File

@ -46,7 +46,8 @@ program DAMASK_spectral
grid, &
geomSize
use CPFEM2, only: &
CPFEM_initAll
CPFEM_initAll, &
CPFEM_results
use FEsolving, only: &
restartWrite, &
restartInc
@ -80,6 +81,7 @@ program DAMASK_spectral
use spectral_mech_Polarisation
use spectral_damage
use spectral_thermal
use results
implicit none
@ -157,6 +159,9 @@ program DAMASK_spectral
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
call results_openJobFile()
call results_closeJobFile()
!--------------------------------------------------------------------------------------------------
! initialize field solver information
nActiveFields = 1
@ -420,6 +425,7 @@ program DAMASK_spectral
writeUndeformed: if (interface_restartInc < 1_pInt) then
write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
call CPFEM_results(0_pInt,0.0_pReal)
do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1?
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
@ -596,6 +602,7 @@ program DAMASK_spectral
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write')
enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
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

8
src/FEM_utilities.f90
View File

@ -162,7 +162,6 @@ subroutine utilities_init()
character(len=1024) :: petsc_optionsPhysics
integer(pInt) :: dimPlex
integer(pInt) :: headerID = 205_pInt
PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:)
PetscInt :: dim
PetscErrorCode :: ierr
@ -213,13 +212,6 @@ subroutine utilities_init()
nOutputCells(worldrank+1) = count(material_homog > 0_pInt)
call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
if (worldrank == 0_pInt) then
open(unit=headerID, file=trim(getSolverJobName())//'.header', &
form='FORMATTED', status='REPLACE')
write(headerID, '(a,i0)') 'dimension : ', dimPlex
write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes)
write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells)
endif
end subroutine utilities_init

3124
src/HDF5_utilities.f90
View File

File diff suppressed because it is too large Load Diff

55
src/IO.f90
View File

@ -186,11 +186,10 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
fileUnit, &
startPos, endPos, &
myTotalLines, & !< # lines read from file without include statements
includedLines, & !< # lines included from other file(s)
missingLines, & !< # lines missing from current file
l,i, &
myStat
logical :: warned
if (present(cnt)) then
if (cnt>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName))
endif
@ -207,37 +206,39 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
!--------------------------------------------------------------------------------------------------
! count lines to allocate string array
myTotalLines = 0_pInt
myTotalLines = 1_pInt
do l=1_pInt, len(rawData)
if (rawData(l:l) == new_line('') .or. l==len(rawData)) myTotalLines = myTotalLines+1 ! end of line or end of file without new line
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
enddo
allocate(fileContent(myTotalLines))
!--------------------------------------------------------------------------------------------------
! split raw data at end of line and handle includes
warned = .false.
startPos = 1_pInt
endPos = 0_pInt
l = 1_pInt
do while (l <= myTotalLines)
endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2_pInt,len(rawData),l /= myTotalLines)
if (endPos - startPos > 255_pInt) then
line = rawData(startPos:startPos+255_pInt)
if (.not. warned) then
call IO_warning(207_pInt,ext_msg=trim(fileName),el=l)
warned = .true.
endif
else
line = rawData(startPos:endpos)
endif
startPos = endPos + 2_pInt ! jump to next line start
includedLines=0_pInt
l=0_pInt
do while (startPos <= len(rawData))
l = l + 1_pInt
endPos = endPos + scan(rawData(startPos:),new_line(''))
if(endPos < startPos) endPos = len(rawData) ! end of file without end of line
if(endPos - startPos >256) call IO_error(107_pInt,ext_msg=trim(fileName))
line = rawData(startPos:endPos-1_pInt)
startPos = endPos + 1_pInt
recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then
myTotalLines = myTotalLines - 1_pInt
recursion: if (scan(trim(adjustl(line)),'{') == 1 .and. scan(trim(line),'}') > 2) then
includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1_pInt:scan(line,'}')-1_pInt)), &
merge(cnt,1_pInt,present(cnt))) ! to track recursion depth
includedLines = includedLines + size(includedContent)
missingLines = myTotalLines + includedLines - size(fileContent(1:l-1)) -size(includedContent)
fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,missingLines)] ] ! add content and grow array
l = l - 1_pInt + size(includedContent)
merge(cnt,1_pInt,present(cnt))) ! to track recursion depth
fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,myTotalLines-l)] ] ! add content and grow array
myTotalLines = myTotalLines - 1_pInt + size(includedContent)
l = l - 1_pInt + size(includedContent)
else recursion
fileContent(l) = line
l = l + 1_pInt
endif recursion
enddo
@ -1236,6 +1237,10 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
msg = 'zero entry on stiffness diagonal'
case (136_pInt)
msg = 'zero entry on stiffness diagonal for transformed phase'
case (137_pInt)
msg = 'not defined for lattice structure'
case (138_pInt)
msg = 'not enough interaction parameters given'
!--------------------------------------------------------------------------------------------------
! errors related to the parsing of material.config
@ -1251,6 +1256,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
msg = 'negative number systems requested'
case (145_pInt)
msg = 'too many systems requested'
case (146_pInt)
msg = 'number of values does not match'
!--------------------------------------------------------------------------------------------------
! material error messages and related messages in mesh
@ -1492,6 +1499,8 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
msg = 'invalid character in string chunk'
case (203_pInt)
msg = 'interpretation of string chunk failed'
case (207_pInt)
msg = 'line truncated'
case (600_pInt)
msg = 'crystallite responds elastically'
case (601_pInt)

18
src/commercialFEM_fileList.f90
View File

@ -4,12 +4,12 @@
!> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard
!--------------------------------------------------------------------------------------------------
#include "IO.f90"
#ifdef DAMASKHDF5
#include "HDF5_utilities.f90"
#endif
#include "numerics.f90"
#include "debug.f90"
#include "config.f90"
#ifdef DAMASKHDF5
#include "HDF5_utilities.f90"
#endif
#include "math.f90"
#include "FEsolving.f90"
#include "mesh.f90"
@ -21,14 +21,9 @@
#include "source_damage_isoDuctile.f90"
#include "source_damage_anisoBrittle.f90"
#include "source_damage_anisoDuctile.f90"
#include "source_vacancy_phenoplasticity.f90"
#include "source_vacancy_irradiation.f90"
#include "source_vacancy_thermalfluc.f90"
#include "kinematics_cleavage_opening.f90"
#include "kinematics_slipplane_opening.f90"
#include "kinematics_thermal_expansion.f90"
#include "kinematics_vacancy_strain.f90"
#include "kinematics_hydrogen_strain.f90"
#include "plastic_none.f90"
#include "plastic_isotropic.f90"
#include "plastic_phenopowerlaw.f90"
@ -47,12 +42,5 @@
#include "damage_none.f90"
#include "damage_local.f90"
#include "damage_nonlocal.f90"
#include "vacancyflux_isoconc.f90"
#include "vacancyflux_isochempot.f90"
#include "vacancyflux_cahnhilliard.f90"
#include "porosity_none.f90"
#include "porosity_phasefield.f90"
#include "hydrogenflux_isoconc.f90"
#include "hydrogenflux_cahnhilliard.f90"
#include "homogenization.f90"
#include "CPFEM.f90"

6
src/compilation_info.f90
View File

@ -1,9 +1,13 @@
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with ', compiler_version()
write(6,*) 'With options ', compiler_options()
#else
#elif defined(__INTEL_COMPILER)
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,&
', build date ', __INTEL_COMPILER_BUILD_DATE
#elif defined(__PGI)
write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,&
'.', __PGIC_MINOR__
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,*)

41
src/config.f90
View File

@ -1,4 +1,4 @@
!--------------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Reads in the material configuration from file
!> @details Reads the material configuration file, where solverJobName.materialConfig takes
@ -220,7 +220,7 @@ subroutine parseFile(sectionNames,part,line, &
partPosition = [partPosition, i] ! needed when actually storing content
do i = 1_pInt, size(partPosition) -1_pInt
sectionNames(i) = trim(adjustl(fileContent(partPosition(i))))
sectionNames(i) = trim(adjustl(IO_getTag(fileContent(partPosition(i)),'[',']')))
do j = partPosition(i) + 1_pInt, partPosition(i+1) -1_pInt
call part(i)%add(trim(adjustl(fileContent(j))))
enddo
@ -318,7 +318,7 @@ subroutine show(this)
do while (associated(item%next))
write(6,'(a)') ' '//trim(item%string%val)
item => item%next
end do
enddo
end subroutine show
@ -391,7 +391,7 @@ logical function keyExists(this,key)
do while (associated(item%next) .and. .not. keyExists)
keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
item => item%next
end do
enddo
end function keyExists
@ -417,7 +417,7 @@ integer(pInt) function countKeys(this,key)
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
countKeys = countKeys + 1_pInt
item => item%next
end do
enddo
end function countKeys
@ -451,7 +451,7 @@ real(pReal) function getFloat(this,key,defaultVal)
getFloat = IO_FloatValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
enddo
if (.not. found) call IO_error(140_pInt,ext_msg=key)
@ -487,7 +487,7 @@ integer(pInt) function getInt(this,key,defaultVal)
getInt = IO_IntValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
enddo
if (.not. found) call IO_error(140_pInt,ext_msg=key)
@ -538,7 +538,7 @@ character(len=65536) function getString(this,key,defaultVal,raw)
endif
endif
item => item%next
end do
enddo
if (.not. found) call IO_error(140_pInt,ext_msg=key)
@ -550,7 +550,7 @@ end function getString
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getFloats(this,key,defaultVal,requiredShape)
function getFloats(this,key,defaultVal,requiredSize)
use IO, only: &
IO_error, &
IO_stringValue, &
@ -561,7 +561,7 @@ function getFloats(this,key,defaultVal,requiredShape)
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
integer(pInt), intent(in), optional :: requiredSize
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
@ -583,11 +583,14 @@ function getFloats(this,key,defaultVal,requiredShape)
enddo
endif
item => item%next
end do
enddo
if (.not. found) then
if (present(defaultVal)) then; getFloats = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
if (present(requiredSize)) then
if(requiredSize /= size(getFloats)) call IO_error(146,ext_msg=key)
endif
end function getFloats
@ -597,7 +600,7 @@ end function getFloats
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getInts(this,key,defaultVal,requiredShape)
function getInts(this,key,defaultVal,requiredSize)
use IO, only: &
IO_error, &
IO_stringValue, &
@ -607,8 +610,8 @@ function getInts(this,key,defaultVal,requiredShape)
integer(pInt), dimension(:), allocatable :: getInts
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:), intent(in), optional :: defaultVal, &
requiredShape
integer(pInt), dimension(:), intent(in), optional :: defaultVal
integer(pInt), intent(in), optional :: requiredSize
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
@ -630,11 +633,14 @@ function getInts(this,key,defaultVal,requiredShape)
enddo
endif
item => item%next
end do
enddo
if (.not. found) then
if (present(defaultVal)) then; getInts = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
if (present(requiredSize)) then
if(requiredSize /= size(getInts)) call IO_error(146,ext_msg=key)
endif
end function getInts
@ -645,7 +651,7 @@ end function getInts
!! values from the last occurrence. If key is not found exits with error unless default is given.
!! If raw is true, the the complete string is returned, otherwise the individual chunks are returned
!--------------------------------------------------------------------------------------------------
function getStrings(this,key,defaultVal,requiredShape,raw)
function getStrings(this,key,defaultVal,raw)
use IO, only: &
IO_error, &
IO_StringValue
@ -655,7 +661,6 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
@ -704,7 +709,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
endif notAllocated
endif
item => item%next
end do
enddo
if (.not. found) then
if (present(defaultVal)) then; getStrings = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif

239
src/constitutive.f90
View File

@ -25,7 +25,8 @@ module constitutive
constitutive_SandItsTangents, &
constitutive_collectDotState, &
constitutive_collectDeltaState, &
constitutive_postResults
constitutive_postResults, &
constitutive_results
private :: &
constitutive_hooke_SandItsTangents
@ -88,14 +89,9 @@ subroutine constitutive_init()
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID, &
SOURCE_vacancy_phenoplasticity_ID, &
SOURCE_vacancy_irradiation_ID, &
SOURCE_vacancy_thermalfluc_ID, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_thermal_expansion_ID, &
KINEMATICS_vacancy_strain_ID, &
KINEMATICS_hydrogen_strain_ID, &
ELASTICITY_HOOKE_label, &
PLASTICITY_NONE_label, &
PLASTICITY_ISOTROPIC_label, &
@ -110,9 +106,6 @@ subroutine constitutive_init()
SOURCE_damage_isoDuctile_label, &
SOURCE_damage_anisoBrittle_label, &
SOURCE_damage_anisoDuctile_label, &
SOURCE_vacancy_phenoplasticity_label, &
SOURCE_vacancy_irradiation_label, &
SOURCE_vacancy_thermalfluc_label, &
plasticState, &
sourceState
@ -129,14 +122,9 @@ subroutine constitutive_init()
use source_damage_isoDuctile
use source_damage_anisoBrittle
use source_damage_anisoDuctile
use source_vacancy_phenoplasticity
use source_vacancy_irradiation
use source_vacancy_thermalfluc
use kinematics_cleavage_opening
use kinematics_slipplane_opening
use kinematics_thermal_expansion
use kinematics_vacancy_strain
use kinematics_hydrogen_strain
implicit none
integer(pInt), parameter :: FILEUNIT = 204_pInt
@ -162,8 +150,8 @@ subroutine constitutive_init()
if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init
if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init
if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT)
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)) then
call plastic_nonlocal_init(FILEUNIT)
@ -179,9 +167,6 @@ subroutine constitutive_init()
if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init(FILEUNIT)
if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(FILEUNIT)
if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(FILEUNIT)
if (any(phase_source == SOURCE_vacancy_phenoplasticity_ID)) call source_vacancy_phenoplasticity_init(FILEUNIT)
if (any(phase_source == SOURCE_vacancy_irradiation_ID)) call source_vacancy_irradiation_init(FILEUNIT)
if (any(phase_source == SOURCE_vacancy_thermalfluc_ID)) call source_vacancy_thermalfluc_init(FILEUNIT)
!--------------------------------------------------------------------------------------------------
! parse kinematic mechanisms from config file
@ -189,8 +174,6 @@ subroutine constitutive_init()
if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init
if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init
if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(FILEUNIT)
if (any(phase_kinematics == KINEMATICS_vacancy_strain_ID)) call kinematics_vacancy_strain_init(FILEUNIT)
if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT)
close(FILEUNIT)
call config_deallocate('material.config/phase')
@ -283,21 +266,6 @@ subroutine constitutive_init()
outputName = SOURCE_damage_anisoDuctile_label
thisOutput => source_damage_anisoDuctile_output
thisSize => source_damage_anisoDuctile_sizePostResult
case (SOURCE_vacancy_phenoplasticity_ID) sourceType
ins = source_vacancy_phenoplasticity_instance(ph)
outputName = SOURCE_vacancy_phenoplasticity_label
thisOutput => source_vacancy_phenoplasticity_output
thisSize => source_vacancy_phenoplasticity_sizePostResult
case (SOURCE_vacancy_irradiation_ID) sourceType
ins = source_vacancy_irradiation_instance(ph)
outputName = SOURCE_vacancy_irradiation_label
thisOutput => source_vacancy_irradiation_output
thisSize => source_vacancy_irradiation_sizePostResult
case (SOURCE_vacancy_thermalfluc_ID) sourceType
ins = source_vacancy_thermalfluc_instance(ph)
outputName = SOURCE_vacancy_thermalfluc_label
thisOutput => source_vacancy_thermalfluc_output
thisSize => source_vacancy_thermalfluc_sizePostResult
case default sourceType
knownSource = .false.
end select sourceType
@ -397,7 +365,7 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el)
use plastic_nonlocal, only: &
plastic_nonlocal_microstructure
use plastic_dislotwin, only: &
plastic_dislotwin_microstructure
plastic_dislotwin_dependentState
use plastic_disloUCLA, only: &
plastic_disloUCLA_dependentState
@ -421,7 +389,9 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el)
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
case (PLASTICITY_DISLOTWIN_ID) plasticityType
call plastic_dislotwin_microstructure(temperature(ho)%p(tme),ipc,ip,el)
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of)
case (PLASTICITY_DISLOUCLA_ID) plasticityType
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
@ -441,9 +411,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
pReal
use math, only: &
math_mul33x33, &
math_Mandel6to33, &
math_Mandel33to6, &
math_Plain99to3333
math_6toSym33, &
math_sym33to6, &
math_99to3333
use material, only: &
phasememberAt, &
phase_plasticity, &
@ -502,7 +472,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
ho = material_homogenizationAt(el)
tme = thermalMapping(ho)%p(ip,el)
S = math_Mandel6to33(S6)
S = math_6toSym33(S6)
Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S)
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
@ -512,8 +482,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
dLp_dMp = 0.0_pReal
case (PLASTICITY_ISOTROPIC_ID) plasticityType
call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el)
dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of)
case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -521,13 +492,14 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of)
case (PLASTICITY_KINEHARDENING_ID) plasticityType
call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el)
dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of)
case (PLASTICITY_NONLOCAL_ID) plasticityType
call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp), &
call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_sym33to6(Mp), &
temperature(ho)%p(tme),ip,el)
dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
dLp_dMp = math_99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
case (PLASTICITY_DISLOTWIN_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -560,6 +532,7 @@ end subroutine constitutive_LpAndItsTangents
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
! ToDo: MD: S is Mi?
!--------------------------------------------------------------------------------------------------
subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, el)
use prec, only: &
@ -568,8 +541,12 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
math_I3, &
math_inv33, &
math_det33, &
math_mul33x33
math_mul33x33, &
math_6toSym33
use material, only: &
phasememberAt, &
phase_plasticity, &
phase_plasticityInstance, &
phase_plasticity, &
material_phase, &
phase_kinematics, &
@ -577,9 +554,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
PLASTICITY_isotropic_ID, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_thermal_expansion_ID, &
KINEMATICS_vacancy_strain_ID, &
KINEMATICS_hydrogen_strain_ID
KINEMATICS_thermal_expansion_ID
use plastic_isotropic, only: &
plastic_isotropic_LiAndItsTangent
use kinematics_cleavage_opening, only: &
@ -588,10 +563,6 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
kinematics_slipplane_opening_LiAndItsTangent
use kinematics_thermal_expansion, only: &
kinematics_thermal_expansion_LiAndItsTangent
use kinematics_vacancy_strain, only: &
kinematics_vacancy_strain_LiAndItsTangent
use kinematics_hydrogen_strain, only: &
kinematics_hydrogen_strain_LiAndItsTangent
implicit none
integer(pInt), intent(in) :: &
@ -607,19 +578,18 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
real(pReal), intent(out), dimension(3,3,3,3) :: &
dLi_dS, & !< derivative of Li with respect to S
dLi_dFi
real(pReal), dimension(3,3) :: &
my_Li !< intermediate velocity gradient
real(pReal), dimension(3,3,3,3) :: &
my_dLi_dS
real(pReal), dimension(3,3) :: &
my_Li, & !< intermediate velocity gradient
FiInv, &
temp_33
real(pReal), dimension(3,3,3,3) :: &
my_dLi_dS
real(pReal) :: &
detFi
integer(pInt) :: &
k !< counter in kinematics loop
integer(pInt) :: &
i, j
k, i, j, &
instance, of
Li = 0.0_pReal
dLi_dS = 0.0_pReal
@ -627,7 +597,9 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
case (PLASTICITY_isotropic_ID) plasticityType
call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el)
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6),instance,of)
case default plasticityType
my_Li = 0.0_pReal
my_dLi_dS = 0.0_pReal
@ -644,10 +616,6 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el)
case (KINEMATICS_thermal_expansion_ID) kinematicsType
call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el)
case (KINEMATICS_vacancy_strain_ID) kinematicsType
call kinematics_vacancy_strain_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el)
case (KINEMATICS_hydrogen_strain_ID) kinematicsType
call kinematics_hydrogen_strain_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el)
case default kinematicsType
my_Li = 0.0_pReal
my_dLi_dS = 0.0_pReal
@ -684,15 +652,9 @@ pure function constitutive_initialFi(ipc, ip, el)
phase_kinematics, &
phase_Nkinematics, &
material_phase, &
KINEMATICS_thermal_expansion_ID, &
KINEMATICS_vacancy_strain_ID, &
KINEMATICS_hydrogen_strain_ID
KINEMATICS_thermal_expansion_ID
use kinematics_thermal_expansion, only: &
kinematics_thermal_expansion_initialStrain
use kinematics_vacancy_strain, only: &
kinematics_vacancy_strain_initialStrain
use kinematics_hydrogen_strain, only: &
kinematics_hydrogen_strain_initialStrain
implicit none
integer(pInt), intent(in) :: &
@ -711,12 +673,6 @@ pure function constitutive_initialFi(ipc, ip, el)
case (KINEMATICS_thermal_expansion_ID) kinematicsType
constitutive_initialFi = &
constitutive_initialFi + kinematics_thermal_expansion_initialStrain(ipc, ip, el)
case (KINEMATICS_vacancy_strain_ID) kinematicsType
constitutive_initialFi = &
constitutive_initialFi + kinematics_vacancy_strain_initialStrain(ipc, ip, el)
case (KINEMATICS_hydrogen_strain_ID) kinematicsType
constitutive_initialFi = &
constitutive_initialFi + kinematics_hydrogen_strain_initialStrain(ipc, ip, el)
end select kinematicsType
enddo KinematicsLoop
@ -762,7 +718,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip
use math, only : &
math_mul33x33, &
math_mul3333xx33, &
math_Mandel66to3333, &
math_66toSym3333, &
math_I3
use material, only: &
material_phase, &
@ -771,10 +727,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip
phase_stiffnessDegradation, &
damage, &
damageMapping, &
porosity, &
porosityMapping, &
STIFFNESS_DEGRADATION_damage_ID, &
STIFFNESS_DEGRADATION_porosity_ID
STIFFNESS_DEGRADATION_damage_ID
implicit none
integer(pInt), intent(in) :: &
@ -798,14 +751,12 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip
i, j
ho = material_homogenizationAt(el)
C = math_Mandel66to3333(constitutive_homogenizedC(ipc,ip,el))
C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el))
DegradationLoop: do d = 1_pInt, phase_NstiffnessDegradations(material_phase(ipc,ip,el))
degradationType: select case(phase_stiffnessDegradation(d,material_phase(ipc,ip,el)))
case (STIFFNESS_DEGRADATION_damage_ID) degradationType
C = C * damage(ho)%p(damageMapping(ho)%p(ip,el))**2_pInt
case (STIFFNESS_DEGRADATION_porosity_ID) degradationType
C = C * porosity(ho)%p(porosityMapping(ho)%p(ip,el))**2_pInt
end select degradationType
enddo DegradationLoop
@ -835,8 +786,8 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
debug_levelBasic
use math, only: &
math_mul33x33, &
math_Mandel6to33, &
math_Mandel33to6, &
math_6toSym33, &
math_sym33to6, &
math_mul33x33
use mesh, only: &
mesh_NcpElems, &
@ -905,18 +856,20 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
integer(pInt) :: &
ho, & !< homogenization
tme, & !< thermal member position
s, & !< counter in source loop
s, & !< counter in source loop
instance, of
ho = material_homogenizationAt(el)
tme = thermalMapping(ho)%p(ip,el)
Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6))
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
case (PLASTICITY_ISOTROPIC_ID) plasticityType
call plastic_isotropic_dotState (math_Mandel33to6(Mp),ipc,ip,el)
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_isotropic_dotState (Mp,instance,of)
case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -924,7 +877,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
call plastic_phenopowerlaw_dotState(Mp,instance,of)
case (PLASTICITY_KINEHARDENING_ID) plasticityType
call plastic_kinehardening_dotState(math_Mandel33to6(Mp),ipc,ip,el)
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_kinehardening_dotState(Mp,instance,of)
case (PLASTICITY_DISLOTWIN_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -937,7 +892,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of)
case (PLASTICITY_NONLOCAL_ID) plasticityType
call plastic_nonlocal_dotState (math_Mandel33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), &
call plastic_nonlocal_dotState (math_sym33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), &
subdt,subfracArray,ip,el)
end select plasticityType
@ -967,7 +922,7 @@ end subroutine constitutive_collectDotState
!> @brief for constitutive models having an instantaneous change of state
!> will return false if delta state is not needed/supported by the constitutive model
!--------------------------------------------------------------------------------------------------
subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el)
subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el)
use prec, only: &
pReal, &
pLongInt
@ -976,71 +931,62 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el)
debug_constitutive, &
debug_levelBasic
use math, only: &
math_Mandel6to33, &
math_Mandel33to6, &
math_sym33to6, &
math_mul33x33
use material, only: &
phasememberAt, &
phase_plasticityInstance, &
phase_plasticity, &
phase_source, &
phase_Nsources, &
material_phase, &
PLASTICITY_KINEHARDENING_ID, &
PLASTICITY_NONLOCAL_ID, &
SOURCE_damage_isoBrittle_ID, &
SOURCE_vacancy_irradiation_ID, &
SOURCE_vacancy_thermalfluc_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
use source_vacancy_irradiation, only: &
source_vacancy_irradiation_deltaState
use source_vacancy_thermalfluc, only: &
source_vacancy_thermalfluc_deltaState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), intent(in), dimension(6) :: &
S6 !< 2nd Piola Kirchhoff stress (vector notation)
real(pReal), intent(in), dimension(3,3) :: &
S, & !< 2nd Piola Kirchhoff stress
Fe, & !< elastic deformation gradient
Fi !< intermediate deformation gradient
real(pReal), dimension(3,3) :: &
Mstar
Mp
integer(pInt) :: &
s !< counter in source loop
i, &
instance, of
Mstar = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S)
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
case (PLASTICITY_KINEHARDENING_ID) plasticityType
call plastic_kinehardening_deltaState(math_Mandel33to6(Mstar),ipc,ip,el)
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_kinehardening_deltaState(Mp,instance,of)
case (PLASTICITY_NONLOCAL_ID) plasticityType
call plastic_nonlocal_deltaState(math_Mandel33to6(Mstar),ip,el)
call plastic_nonlocal_deltaState(math_sym33to6(Mp),ip,el)
end select plasticityType
sourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el))
sourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el))
sourceType: select case (phase_source(s,material_phase(ipc,ip,el)))
sourceType: select case (phase_source(i,material_phase(ipc,ip,el)))
case (SOURCE_damage_isoBrittle_ID) sourceType
call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, &
ipc, ip, el)
case (SOURCE_vacancy_irradiation_ID) sourceType
call source_vacancy_irradiation_deltaState(ipc, ip, el)
case (SOURCE_vacancy_thermalfluc_ID) sourceType
call source_vacancy_thermalfluc_deltaState(ipc, ip, el)
end select sourceType
enddo SourceLoop
@ -1055,7 +1001,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
use prec, only: &
pReal
use math, only: &
math_Mandel6to33, &
math_6toSym33, &
math_mul33x33
use mesh, only: &
mesh_NcpElems, &
@ -1130,7 +1076,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
constitutive_postResults = 0.0_pReal
Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6))
ho = material_homogenizationAt(el)
tme = thermalMapping(ho)%p(ip,el)
@ -1140,8 +1086,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
case (PLASTICITY_ISOTROPIC_ID) plasticityType
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
constitutive_postResults(startPos:endPos) = &
plastic_isotropic_postResults(S6,ipc,ip,el)
plastic_isotropic_postResults(Mp,instance,of)
case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -1150,8 +1098,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
plastic_phenopowerlaw_postResults(Mp,instance,of)
case (PLASTICITY_KINEHARDENING_ID) plasticityType
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
constitutive_postResults(startPos:endPos) = &
plastic_kinehardening_postResults(S6,ipc,ip,el)
plastic_kinehardening_postResults(Mp,instance,of)
case (PLASTICITY_DISLOTWIN_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -1189,4 +1139,43 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
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(DAMASKHDF5)
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_phenopowerlaw, only: &
plastic_phenopowerlaw_results
implicit none
integer(pInt) :: p
call HDF5_closeGroup(results_addGroup('current/phase'))
do p=1,size(config_name_phase)
call HDF5_closeGroup(results_addGroup('current/phase/'//trim(config_name_phase(p))))
if (material_phase_plasticity_type(p) == PLASTICITY_PHENOPOWERLAW_ID) then
call plastic_phenopowerlaw_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
endif
enddo
#endif
end subroutine constitutive_results
end module constitutive

4923
src/crystallite.f90
View File

File diff suppressed because it is too large Load Diff

428
src/homogenization.f90
View File

@ -25,10 +25,7 @@ module homogenization
materialpoint_sizeResults, &
homogenization_maxSizePostResults, &
thermal_maxSizePostResults, &
damage_maxSizePostResults, &
vacancyflux_maxSizePostResults, &
porosity_maxSizePostResults, &
hydrogenflux_maxSizePostResults
damage_maxSizePostResults
real(pReal), dimension(:,:,:,:), allocatable, private :: &
materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment
@ -48,10 +45,10 @@ module homogenization
materialpoint_stressAndItsTangent, &
materialpoint_postResults
private :: &
homogenization_partitionDeformation, &
homogenization_updateState, &
homogenization_averageStressAndItsTangent, &
homogenization_postResults
partitionDeformation, &
updateState, &
averageStressAndItsTangent, &
postResults
contains
@ -100,13 +97,6 @@ subroutine homogenization_init
use damage_none
use damage_local
use damage_nonlocal
use vacancyflux_isoconc
use vacancyflux_isochempot
use vacancyflux_cahnhilliard
use porosity_none
use porosity_phasefield
use hydrogenflux_isoconc
use hydrogenflux_cahnhilliard
use IO
use numerics, only: &
worldrank
@ -128,12 +118,9 @@ subroutine homogenization_init
!--------------------------------------------------------------------------------------------------
! parse homogenization from config file
if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) &
call homogenization_none_init()
if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) &
call homogenization_isostrain_init(FILEUNIT)
if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) &
call homogenization_RGC_init(FILEUNIT)
if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call homogenization_none_init
if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call homogenization_isostrain_init
if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call homogenization_RGC_init
!--------------------------------------------------------------------------------------------------
! parse thermal from config file
@ -155,33 +142,6 @@ subroutine homogenization_init
if (any(damage_type == DAMAGE_nonlocal_ID)) &
call damage_nonlocal_init(FILEUNIT)
!--------------------------------------------------------------------------------------------------
! parse vacancy transport from config file
call IO_checkAndRewind(FILEUNIT)
if (any(vacancyflux_type == VACANCYFLUX_isoconc_ID)) &
call vacancyflux_isoconc_init()
if (any(vacancyflux_type == VACANCYFLUX_isochempot_ID)) &
call vacancyflux_isochempot_init(FILEUNIT)
if (any(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID)) &
call vacancyflux_cahnhilliard_init(FILEUNIT)
!--------------------------------------------------------------------------------------------------
! parse porosity from config file
call IO_checkAndRewind(FILEUNIT)
if (any(porosity_type == POROSITY_none_ID)) &
call porosity_none_init()
if (any(porosity_type == POROSITY_phasefield_ID)) &
call porosity_phasefield_init(FILEUNIT)
!--------------------------------------------------------------------------------------------------
! parse hydrogen transport from config file
call IO_checkAndRewind(FILEUNIT)
if (any(hydrogenflux_type == HYDROGENFLUX_isoconc_ID)) &
call hydrogenflux_isoconc_init()
if (any(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID)) &
call hydrogenflux_cahnhilliard_init(FILEUNIT)
close(FILEUNIT)
!--------------------------------------------------------------------------------------------------
! write description file for homogenization output
mainProcess2: if (worldrank == 0) then
@ -193,17 +153,14 @@ subroutine homogenization_init
select case(homogenization_type(p)) ! split per homogenization type
case (HOMOGENIZATION_NONE_ID)
outputName = HOMOGENIZATION_NONE_label
thisNoutput => null()
thisOutput => null()
thisSize => null()
case (HOMOGENIZATION_ISOSTRAIN_ID)
outputName = HOMOGENIZATION_ISOSTRAIN_label
thisNoutput => homogenization_isostrain_Noutput
thisOutput => homogenization_isostrain_output
thisSize => homogenization_isostrain_sizePostResult
thisOutput => null()
thisSize => null()
case (HOMOGENIZATION_RGC_ID)
outputName = HOMOGENIZATION_RGC_label
thisNoutput => homogenization_RGC_Noutput
thisOutput => homogenization_RGC_output
thisSize => homogenization_RGC_sizePostResult
case default
@ -213,8 +170,9 @@ subroutine homogenization_init
if (valid) then
write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName)
write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p)
if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID) then
do e = 1,thisNoutput(i)
if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID .and. &
homogenization_type(p) /= HOMOGENIZATION_ISOSTRAIN_ID) then
do e = 1,size(thisOutput(:,i))
write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
enddo
endif
@ -277,83 +235,6 @@ subroutine homogenization_init
enddo
endif
endif
i = vacancyflux_typeInstance(p) ! which instance of this vacancy flux type
valid = .true. ! assume valid
select case(vacancyflux_type(p)) ! split per vacancy flux type
case (VACANCYFLUX_isoconc_ID)
outputName = VACANCYFLUX_isoconc_label
thisNoutput => null()
thisOutput => null()
thisSize => null()
case (VACANCYFLUX_isochempot_ID)
outputName = VACANCYFLUX_isochempot_label
thisNoutput => vacancyflux_isochempot_Noutput
thisOutput => vacancyflux_isochempot_output
thisSize => vacancyflux_isochempot_sizePostResult
case (VACANCYFLUX_cahnhilliard_ID)
outputName = VACANCYFLUX_cahnhilliard_label
thisNoutput => vacancyflux_cahnhilliard_Noutput
thisOutput => vacancyflux_cahnhilliard_output
thisSize => vacancyflux_cahnhilliard_sizePostResult
case default
valid = .false.
end select
if (valid) then
write(FILEUNIT,'(a)') '(vacancyflux)'//char(9)//trim(outputName)
if (vacancyflux_type(p) /= VACANCYFLUX_isoconc_ID) then
do e = 1,thisNoutput(i)
write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
enddo
endif
endif
i = porosity_typeInstance(p) ! which instance of this porosity type
valid = .true. ! assume valid
select case(porosity_type(p)) ! split per porosity type
case (POROSITY_none_ID)
outputName = POROSITY_none_label
thisNoutput => null()
thisOutput => null()
thisSize => null()
case (POROSITY_phasefield_ID)
outputName = POROSITY_phasefield_label
thisNoutput => porosity_phasefield_Noutput
thisOutput => porosity_phasefield_output
thisSize => porosity_phasefield_sizePostResult
case default
valid = .false.
end select
if (valid) then
write(FILEUNIT,'(a)') '(porosity)'//char(9)//trim(outputName)
if (porosity_type(p) /= POROSITY_none_ID) then
do e = 1,thisNoutput(i)
write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
enddo
endif
endif
i = hydrogenflux_typeInstance(p) ! which instance of this hydrogen flux type
valid = .true. ! assume valid
select case(hydrogenflux_type(p)) ! split per hydrogen flux type
case (HYDROGENFLUX_isoconc_ID)
outputName = HYDROGENFLUX_isoconc_label
thisNoutput => null()
thisOutput => null()
thisSize => null()
case (HYDROGENFLUX_cahnhilliard_ID)
outputName = HYDROGENFLUX_cahnhilliard_label
thisNoutput => hydrogenflux_cahnhilliard_Noutput
thisOutput => hydrogenflux_cahnhilliard_output
thisSize => hydrogenflux_cahnhilliard_sizePostResult
case default
valid = .false.
end select
if (valid) then
write(FILEUNIT,'(a)') '(hydrogenflux)'//char(9)//trim(outputName)
if (hydrogenflux_type(p) /= HYDROGENFLUX_isoconc_ID) then
do e = 1,thisNoutput(i)
write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
enddo
endif
endif
endif
enddo
close(FILEUNIT)
@ -383,25 +264,16 @@ subroutine homogenization_init
homogenization_maxSizePostResults = 0_pInt
thermal_maxSizePostResults = 0_pInt
damage_maxSizePostResults = 0_pInt
vacancyflux_maxSizePostResults = 0_pInt
porosity_maxSizePostResults = 0_pInt
hydrogenflux_maxSizePostResults = 0_pInt
do p = 1,size(config_homogenization)
homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults)
thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults)
damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults)
vacancyflux_maxSizePostResults = max(vacancyflux_maxSizePostResults ,vacancyfluxState (p)%sizePostResults)
porosity_maxSizePostResults = max(porosity_maxSizePostResults ,porosityState (p)%sizePostResults)
hydrogenflux_maxSizePostResults = max(hydrogenflux_maxSizePostResults ,hydrogenfluxState(p)%sizePostResults)
enddo
materialpoint_sizeResults = 1 & ! grain count
+ 1 + homogenization_maxSizePostResults & ! homogSize & homogResult
+ thermal_maxSizePostResults &
+ damage_maxSizePostResults &
+ vacancyflux_maxSizePostResults &
+ porosity_maxSizePostResults &
+ hydrogenflux_maxSizePostResults &
+ homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results
+ 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results
+ constitutive_source_maxSizePostResults)
@ -460,9 +332,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
porosityState, &
hydrogenfluxState, &
phase_Nsources, &
mappingHomogenization, &
phaseAt, phasememberAt, &
@ -478,7 +347,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF, &
crystallite_dPdF0, &
crystallite_Tstar0_v, &
crystallite_Tstar_v, &
crystallite_partionedF0, &
@ -487,12 +355,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
crystallite_partionedLp0, &
crystallite_partionedFi0, &
crystallite_partionedLi0, &
crystallite_partioneddPdF0, &
crystallite_partionedTstar0_v, &
crystallite_dt, &
crystallite_requested, &
crystallite_converged, &
crystallite_stressAndItsTangent, &
crystallite_stress, &
crystallite_stressTangent, &
crystallite_orientations
#ifdef DEBUG
use debug, only: &
@ -545,7 +412,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) ! ...plastic velocity grads
crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) ! ...intermediate def grads
crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) ! ...intermediate velocity grads
crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,g,i,e) = crystallite_dPdF0(1:3,1:3,1:3,1:3,g,i,e) ! ...stiffness
crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) ! ...def grads
crystallite_partionedTstar0_v(1:6,g,i,e) = crystallite_Tstar0_v(1:6,g,i,e) ! ...2nd PK stress
@ -569,18 +435,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
damageState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
vacancyfluxState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal vacancy transport state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
porosityState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal porosity state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
hydrogenfluxState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal hydrogen transport state
enddo
NiterationHomog = 0_pInt
@ -627,9 +481,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_Li(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads
crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e) ! ...stiffness
crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) = &
crystallite_Tstar_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress
@ -654,18 +505,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
vacancyfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal vacancy transport state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
porosityState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal porosity state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
hydrogenfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal hydrogen transport state
materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad
endif steppingNeeded
@ -705,8 +544,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads
crystallite_Li(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads
crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = &
crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) ! ...stiffness
crystallite_Tstar_v(1:6,1:myNgrains,i,e) = &
crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress
do g = 1, myNgrains
@ -729,18 +566,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = &
damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
vacancyfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = &
vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal vacancy transport state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
porosityState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = &
porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal porosity state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
hydrogenfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = &
hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal hydrogen transport state
endif
endif converged
@ -775,7 +600,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
if ( materialpoint_requested(i,e) .and. & ! process requested but...
.not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points
call homogenization_partitionDeformation(i,e) ! partition deformation onto constituents
call partitionDeformation(i,e) ! partition deformation onto constituents
crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e) ! propagate materialpoint dt to grains
crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents
else
@ -789,7 +614,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
! crystallite integration
! based on crystallite_partionedF0,.._partionedF
! incrementing by crystallite_dt
call crystallite_stressAndItsTangent(updateJaco) ! request stress and tangent calculation for constituent grains
materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic
!--------------------------------------------------------------------------------------------------
! state update
@ -798,11 +623,10 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
IpLooping3: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
if ( materialpoint_requested(i,e) .and. &
.not. materialpoint_doneAndHappy(1,i,e)) then
if (.not. all(crystallite_converged(:,i,e))) then
if (.not. materialpoint_converged(i,e)) then
materialpoint_doneAndHappy(1:2,i,e) = [.true.,.false.]
materialpoint_converged(i,e) = .false.
else
materialpoint_doneAndHappy(1:2,i,e) = homogenization_updateState(i,e)
materialpoint_doneAndHappy(1:2,i,e) = updateState(i,e)
materialpoint_converged(i,e) = all(materialpoint_doneAndHappy(1:2,i,e)) ! converged if done and happy
endif
endif
@ -815,13 +639,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
NiterationHomog = NiterationHomog + 1_pInt
enddo cutBackLooping
if(updateJaco) call crystallite_stressTangent
if (.not. terminallyIll ) then
call crystallite_orientations() ! calculate crystal orientations
!$OMP PARALLEL DO
elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2)
IpLooping4: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
call homogenization_averageStressAndItsTangent(i,e)
call averageStressAndItsTangent(i,e)
enddo IpLooping4
enddo elementLooping4
!$OMP END PARALLEL DO
@ -846,9 +672,6 @@ subroutine materialpoint_postResults
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
porosityState, &
hydrogenfluxState, &
plasticState, &
sourceState, &
material_phase, &
@ -877,15 +700,12 @@ subroutine materialpoint_postResults
theSize = homogState (mappingHomogenization(2,i,e))%sizePostResults &
+ thermalState (mappingHomogenization(2,i,e))%sizePostResults &
+ damageState (mappingHomogenization(2,i,e))%sizePostResults &
+ vacancyfluxState (mappingHomogenization(2,i,e))%sizePostResults &
+ porosityState (mappingHomogenization(2,i,e))%sizePostResults &
+ hydrogenfluxState(mappingHomogenization(2,i,e))%sizePostResults
+ damageState (mappingHomogenization(2,i,e))%sizePostResults
materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results
thePos = thePos + 1_pInt
if (theSize > 0_pInt) then ! any homogenization results to mention?
materialpoint_results(thePos+1:thePos+theSize,i,e) = homogenization_postResults(i,e) ! tell homogenization results
materialpoint_results(thePos+1:thePos+theSize,i,e) = postResults(i,e) ! tell homogenization results
thePos = thePos + theSize
endif
@ -909,12 +729,12 @@ end subroutine materialpoint_postResults
!--------------------------------------------------------------------------------------------------
!> @brief partition material point def grad onto constituents
!--------------------------------------------------------------------------------------------------
subroutine homogenization_partitionDeformation(ip,el)
subroutine partitionDeformation(ip,el)
use mesh, only: &
mesh_element
use material, only: &
homogenization_type, &
homogenization_maxNgrains, &
homogenization_Ngrains, &
HOMOGENIZATION_NONE_ID, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_RGC_ID
@ -933,43 +753,39 @@ subroutine homogenization_partitionDeformation(ip,el)
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el) = 0.0_pReal
crystallite_partionedF(1:3,1:3,1:1,ip,el) = &
spread(materialpoint_subF(1:3,1:3,ip,el),3,1)
crystallite_partionedF(1:3,1:3,1,ip,el) = materialpoint_subF(1:3,1:3,ip,el)
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
call homogenization_isostrain_partitionDeformation(&
crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
materialpoint_subF(1:3,1:3,ip,el),&
el)
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
materialpoint_subF(1:3,1:3,ip,el))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call homogenization_RGC_partitionDeformation(&
crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
materialpoint_subF(1:3,1:3,ip,el),&
ip, &
el)
end select chosenHomogenization
end subroutine homogenization_partitionDeformation
end subroutine partitionDeformation
!--------------------------------------------------------------------------------------------------
!> @brief update the internal state of the homogenization scheme and tell whether "done" and
!> "happy" with result
!--------------------------------------------------------------------------------------------------
function homogenization_updateState(ip,el)
function updateState(ip,el)
use mesh, only: &
mesh_element
use material, only: &
homogenization_type, &
thermal_type, &
damage_type, &
vacancyflux_type, &
homogenization_maxNgrains, &
homogenization_Ngrains, &
HOMOGENIZATION_RGC_ID, &
THERMAL_adiabatic_ID, &
DAMAGE_local_ID, &
VACANCYFLUX_isochempot_ID
DAMAGE_local_ID
use crystallite, only: &
crystallite_P, &
crystallite_dPdF, &
@ -981,34 +797,32 @@ function homogenization_updateState(ip,el)
thermal_adiabatic_updateState
use damage_local, only: &
damage_local_updateState
use vacancyflux_isochempot, only: &
vacancyflux_isochempot_updateState
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element number
logical, dimension(2) :: homogenization_updateState
logical, dimension(2) :: updateState
homogenization_updateState = .true.
updateState = .true.
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
homogenization_updateState = &
homogenization_updateState .and. &
homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
crystallite_partionedF0(1:3,1:3,1:homogenization_maxNgrains,ip,el),&
updateState = &
updateState .and. &
homogenization_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),&
materialpoint_subF(1:3,1:3,ip,el),&
materialpoint_subdt(ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
ip, &
el)
end select chosenHomogenization
chosenThermal: select case (thermal_type(mesh_element(3,el)))
case (THERMAL_adiabatic_ID) chosenThermal
homogenization_updateState = &
homogenization_updateState .and. &
updateState = &
updateState .and. &
thermal_adiabatic_updateState(materialpoint_subdt(ip,el), &
ip, &
el)
@ -1016,34 +830,26 @@ function homogenization_updateState(ip,el)
chosenDamage: select case (damage_type(mesh_element(3,el)))
case (DAMAGE_local_ID) chosenDamage
homogenization_updateState = &
homogenization_updateState .and. &
updateState = &
updateState .and. &
damage_local_updateState(materialpoint_subdt(ip,el), &
ip, &
el)
end select chosenDamage
chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el)))
case (VACANCYFLUX_isochempot_ID) chosenVacancyflux
homogenization_updateState = &
homogenization_updateState .and. &
vacancyflux_isochempot_updateState(materialpoint_subdt(ip,el), &
ip, &
el)
end select chosenVacancyflux
end function homogenization_updateState
end function updateState
!--------------------------------------------------------------------------------------------------
!> @brief derive average stress and stiffness from constituent quantities
!--------------------------------------------------------------------------------------------------
subroutine homogenization_averageStressAndItsTangent(ip,el)
subroutine averageStressAndItsTangent(ip,el)
use mesh, only: &
mesh_element
use material, only: &
homogenization_type, &
homogenization_maxNgrains, &
homogenization_typeInstance, &
homogenization_Ngrains, &
HOMOGENIZATION_NONE_ID, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_RGC_ID
@ -1061,49 +867,46 @@ subroutine homogenization_averageStressAndItsTangent(ip,el)
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
materialpoint_P(1:3,1:3,ip,el) = sum(crystallite_P(1:3,1:3,1:1,ip,el),3)
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) &
= sum(crystallite_dPdF(1:3,1:3,1:3,1:3,1:1,ip,el),5)
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)
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
call homogenization_isostrain_averageStressAndItsTangent(&
materialpoint_P(1:3,1:3,ip,el), &
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), &
el)
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)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call homogenization_RGC_averageStressAndItsTangent(&
materialpoint_P(1:3,1:3,ip,el), &
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), &
el)
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)))
end select chosenHomogenization
end subroutine homogenization_averageStressAndItsTangent
end subroutine averageStressAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of homogenization results for post file inclusion. call only,
!> if homogenization_sizePostResults(i,e) > 0 !!
!--------------------------------------------------------------------------------------------------
function homogenization_postResults(ip,el)
function postResults(ip,el)
use mesh, only: &
mesh_element
use material, only: &
material_homogenizationAt, &
homogenization_typeInstance,&
mappingHomogenization, &
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
porosityState, &
hydrogenfluxState, &
homogenization_type, &
thermal_type, &
damage_type, &
vacancyflux_type, &
porosity_type, &
hydrogenflux_type, &
HOMOGENIZATION_NONE_ID, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_RGC_ID, &
@ -1112,16 +915,7 @@ function homogenization_postResults(ip,el)
THERMAL_conduction_ID, &
DAMAGE_none_ID, &
DAMAGE_local_ID, &
DAMAGE_nonlocal_ID, &
VACANCYFLUX_isoconc_ID, &
VACANCYFLUX_isochempot_ID, &
VACANCYFLUX_cahnhilliard_ID, &
POROSITY_none_ID, &
POROSITY_phasefield_ID, &
HYDROGENFLUX_isoconc_ID, &
HYDROGENFLUX_cahnhilliard_ID
use homogenization_isostrain, only: &
homogenization_isostrain_postResults
DAMAGE_nonlocal_ID
use homogenization_RGC, only: &
homogenization_RGC_postResults
use thermal_adiabatic, only: &
@ -1132,14 +926,6 @@ function homogenization_postResults(ip,el)
damage_local_postResults
use damage_nonlocal, only: &
damage_nonlocal_postResults
use vacancyflux_isochempot, only: &
vacancyflux_isochempot_postResults
use vacancyflux_cahnhilliard, only: &
vacancyflux_cahnhilliard_postResults
use porosity_phasefield, only: &
porosity_phasefield_postResults
use hydrogenflux_cahnhilliard, only: &
hydrogenflux_cahnhilliard_postResults
implicit none
integer(pInt), intent(in) :: &
@ -1147,97 +933,47 @@ function homogenization_postResults(ip,el)
el !< element number
real(pReal), dimension( homogState (mappingHomogenization(2,ip,el))%sizePostResults &
+ thermalState (mappingHomogenization(2,ip,el))%sizePostResults &
+ damageState (mappingHomogenization(2,ip,el))%sizePostResults &
+ vacancyfluxState (mappingHomogenization(2,ip,el))%sizePostResults &
+ porosityState (mappingHomogenization(2,ip,el))%sizePostResults &
+ hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults) :: &
homogenization_postResults
+ damageState (mappingHomogenization(2,ip,el))%sizePostResults) :: &
postResults
integer(pInt) :: &
startPos, endPos
startPos, endPos ,&
of, instance
homogenization_postResults = 0.0_pReal
postResults = 0.0_pReal
startPos = 1_pInt
endPos = homogState(mappingHomogenization(2,ip,el))%sizePostResults
chosenHomogenization: select case (homogenization_type(mesh_element(3,el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
homogenization_postResults(startPos:endPos) = &
homogenization_isostrain_postResults(&
ip, &
el, &
materialpoint_P(1:3,1:3,ip,el), &
materialpoint_F(1:3,1:3,ip,el))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
homogenization_postResults(startPos:endPos) = &
homogenization_RGC_postResults(&
ip, &
el, &
materialpoint_P(1:3,1:3,ip,el), &
materialpoint_F(1:3,1:3,ip,el))
instance = homogenization_typeInstance(material_homogenizationAt(el))
of = mappingHomogenization(1,ip,el)
postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of)
end select chosenHomogenization
startPos = endPos + 1_pInt
endPos = endPos + thermalState(mappingHomogenization(2,ip,el))%sizePostResults
chosenThermal: select case (thermal_type(mesh_element(3,el)))
case (THERMAL_isothermal_ID) chosenThermal
case (THERMAL_adiabatic_ID) chosenThermal
homogenization_postResults(startPos:endPos) = &
thermal_adiabatic_postResults(ip, el)
postResults(startPos:endPos) = thermal_adiabatic_postResults(ip, el)
case (THERMAL_conduction_ID) chosenThermal
homogenization_postResults(startPos:endPos) = &
thermal_conduction_postResults(ip, el)
postResults(startPos:endPos) = thermal_conduction_postResults(ip, el)
end select chosenThermal
startPos = endPos + 1_pInt
endPos = endPos + damageState(mappingHomogenization(2,ip,el))%sizePostResults
chosenDamage: select case (damage_type(mesh_element(3,el)))
case (DAMAGE_none_ID) chosenDamage
case (DAMAGE_local_ID) chosenDamage
homogenization_postResults(startPos:endPos) = &
damage_local_postResults(ip, el)
postResults(startPos:endPos) = damage_local_postResults(ip, el)
case (DAMAGE_nonlocal_ID) chosenDamage
homogenization_postResults(startPos:endPos) = &
damage_nonlocal_postResults(ip, el)
postResults(startPos:endPos) = damage_nonlocal_postResults(ip, el)
end select chosenDamage
startPos = endPos + 1_pInt
endPos = endPos + vacancyfluxState(mappingHomogenization(2,ip,el))%sizePostResults
chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el)))
case (VACANCYFLUX_isoconc_ID) chosenVacancyflux
case (VACANCYFLUX_isochempot_ID) chosenVacancyflux
homogenization_postResults(startPos:endPos) = &
vacancyflux_isochempot_postResults(ip, el)
case (VACANCYFLUX_cahnhilliard_ID) chosenVacancyflux
homogenization_postResults(startPos:endPos) = &
vacancyflux_cahnhilliard_postResults(ip, el)
end select chosenVacancyflux
startPos = endPos + 1_pInt
endPos = endPos + porosityState(mappingHomogenization(2,ip,el))%sizePostResults
chosenPorosity: select case (porosity_type(mesh_element(3,el)))
case (POROSITY_none_ID) chosenPorosity
case (POROSITY_phasefield_ID) chosenPorosity
homogenization_postResults(startPos:endPos) = &
porosity_phasefield_postResults(ip, el)
end select chosenPorosity
startPos = endPos + 1_pInt
endPos = endPos + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults
chosenHydrogenflux: select case (hydrogenflux_type(mesh_element(3,el)))
case (HYDROGENFLUX_isoconc_ID) chosenHydrogenflux
case (HYDROGENFLUX_cahnhilliard_ID) chosenHydrogenflux
homogenization_postResults(startPos:endPos) = &
hydrogenflux_cahnhilliard_postResults(ip, el)
end select chosenHydrogenflux
end function homogenization_postResults
end function postResults
end module homogenization

1789
src/homogenization_RGC.f90
View File

File diff suppressed because it is too large Load Diff

321
src/homogenization_isostrain.f90
View File

@ -1,4 +1,5 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Isostrain (full constraint Taylor assuption) homogenization scheme
@ -6,220 +7,119 @@
module homogenization_isostrain
use prec, only: &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
homogenization_isostrain_sizePostResults
integer(pInt), dimension(:,:), allocatable, target, public :: &
homogenization_isostrain_sizePostResult
character(len=64), dimension(:,:), allocatable, target, public :: &
homogenization_isostrain_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
homogenization_isostrain_Noutput !< number of outputs per homog instance
integer(pInt), dimension(:), allocatable, private :: &
homogenization_isostrain_Ngrains
enum, bind(c)
enumerator :: undefined_ID, &
nconstituents_ID, &
ipcoords_ID, &
avgdefgrad_ID, &
avgfirstpiola_ID
enumerator :: &
parallel_ID, &
average_ID
end enum
enum, bind(c)
enumerator :: parallel_ID, &
average_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
homogenization_isostrain_outputID !< ID of each post result output
integer(kind(average_ID)), dimension(:), allocatable, private :: &
homogenization_isostrain_mapping !< mapping type
type, private :: tParameters !< container type for internal constitutive parameters
integer(pInt) :: &
Nconstituents
integer(kind(average_ID)) :: &
mapping
end type
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
public :: &
homogenization_isostrain_init, &
homogenization_isostrain_partitionDeformation, &
homogenization_isostrain_averageStressAndItsTangent, &
homogenization_isostrain_postResults
homogenization_isostrain_averageStressAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_isostrain_init(fileUnit)
subroutine homogenization_isostrain_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pReal
use debug, only: &
debug_HOMOGENIZATION, &
debug_level, &
debug_levelBasic
use IO
use material
use config
use IO, only: &
IO_timeStamp, &
IO_error
use material, only: &
homogenization_type, &
material_homog, &
homogState, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_ISOSTRAIN_LABEL, &
homogenization_typeInstance
use config, only: &
config_homogenization
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
section = 0_pInt, i, mySize, o
integer :: &
maxNinstance, &
homog, &
instance
integer :: &
NofMyHomog ! no pInt (stores a system dependen value from 'count'
Ninstance, &
h, &
NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
tag = ''
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)
if (maxNinstance == 0) return
Ninstance = int(count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID),pInt)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(homogenization_isostrain_sizePostResults(maxNinstance), source=0_pInt)
allocate(homogenization_isostrain_sizePostResult(maxval(homogenization_Noutput),maxNinstance), &
source=0_pInt)
allocate(homogenization_isostrain_Noutput(maxNinstance), source=0_pInt)
allocate(homogenization_isostrain_Ngrains(maxNinstance), source=0_pInt)
allocate(homogenization_isostrain_mapping(maxNinstance), source=average_ID)
allocate(homogenization_isostrain_output(maxval(homogenization_Noutput),maxNinstance))
homogenization_isostrain_output = ''
allocate(homogenization_isostrain_outputID(maxval(homogenization_Noutput),maxNinstance), &
source=undefined_ID)
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(param(Ninstance)) ! one container of parameters per instance
do h = 1_pInt, size(homogenization_type)
if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle
associate(prm => param(homogenization_typeInstance(h)),&
config => config_homogenization(h))
prm%Nconstituents = config_homogenization(h)%getInt('nconstituents')
tag = 'sum'
select case(trim(config%getString('mapping',defaultVal = tag)))
case ('sum')
prm%mapping = parallel_ID
case ('avg')
prm%mapping = average_ID
case default
call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')')
end select
NofMyHomog = count(material_homog == h)
homogState(h)%sizeState = 0_pInt
homogState(h)%sizePostResults = 0_pInt
allocate(homogState(h)%state0 (0_pInt,NofMyHomog))
allocate(homogState(h)%subState0(0_pInt,NofMyHomog))
allocate(homogState(h)%state (0_pInt,NofMyHomog))
end associate
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homogenization part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt
cycle
endif
if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran
if (homogenization_type(section) == HOMOGENIZATION_ISOSTRAIN_ID) then ! one of my sections
i = homogenization_typeInstance(section) ! which instance of my type is present homogenization
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case('nconstituents','ngrains')
homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = nconstituents_ID
homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('ipcoords')
homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = ipcoords_ID
homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('avgdefgrad','avgf')
homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgdefgrad_ID
homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('avgp','avgfirstpiola','avg1stpiola')
homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgfirstpiola_ID
homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
case ('nconstituents','ngrains')
homogenization_isostrain_Ngrains(i) = IO_intValue(line,chunkPos,2_pInt)
case ('mapping')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('parallel','sum')
homogenization_isostrain_mapping(i) = parallel_ID
case ('average','mean','avg')
homogenization_isostrain_mapping(i) = average_ID
case default
call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')')
end select
end select
endif
endif
enddo parsingFile
initializeInstances: do homog = 1_pInt, material_Nhomogenization
myHomog: if (homogenization_type(homog) == HOMOGENIZATION_ISOSTRAIN_ID) then
NofMyHomog = count(material_homog == homog)
instance = homogenization_typeInstance(homog)
! * Determine size of postResults array
outputsLoop: do o = 1_pInt, homogenization_isostrain_Noutput(instance)
select case(homogenization_isostrain_outputID(o,instance))
case(nconstituents_ID)
mySize = 1_pInt
case(ipcoords_ID)
mySize = 3_pInt
case(avgdefgrad_ID, avgfirstpiola_ID)
mySize = 9_pInt
case default
mySize = 0_pInt
end select
outputFound: if (mySize > 0_pInt) then
homogenization_isostrain_sizePostResult(o,instance) = mySize
homogenization_isostrain_sizePostResults(instance) = &
homogenization_isostrain_sizePostResults(instance) + mySize
endif outputFound
enddo outputsLoop
! allocate state arrays
homogState(homog)%sizeState = 0_pInt
homogState(homog)%sizePostResults = homogenization_isostrain_sizePostResults(instance)
allocate(homogState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal)
allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
allocate(homogState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal)
endif myHomog
enddo initializeInstances
end subroutine homogenization_isostrain_init
!--------------------------------------------------------------------------------------------------
!> @brief partitions the deformation gradient onto the constituents
!--------------------------------------------------------------------------------------------------
subroutine homogenization_isostrain_partitionDeformation(F,avgF,el)
subroutine homogenization_isostrain_partitionDeformation(F,avgF)
use prec, only: &
pReal
use mesh, only: &
mesh_element
use material, only: &
homogenization_maxNgrains, &
homogenization_Ngrains
implicit none
real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned def grad per grain
real(pReal), dimension (3,3), intent(in) :: avgF !< my average def grad
integer(pInt), intent(in) :: &
el !< element number
F=0.0_pReal
F(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)))= &
spread(avgF,3,homogenization_Ngrains(mesh_element(3,el)))
real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
F = spread(avgF,3,size(F,3))
end subroutine homogenization_isostrain_partitionDeformation
@ -227,90 +127,31 @@ end subroutine homogenization_isostrain_partitionDeformation
!--------------------------------------------------------------------------------------------------
!> @brief derive average stress and stiffness from constituent quantities
!--------------------------------------------------------------------------------------------------
subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,el)
subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
use prec, only: &
pReal
use mesh, only: &
mesh_element
use material, only: &
homogenization_maxNgrains, &
homogenization_Ngrains, &
homogenization_typeInstance
implicit none
real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point
real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point
real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses
real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses
integer(pInt), intent(in) :: el !< element number
integer(pInt) :: &
homID, &
Ngrains
real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point
real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point
homID = homogenization_typeInstance(mesh_element(3,el))
Ngrains = homogenization_Ngrains(mesh_element(3,el))
real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses
real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
integer(pInt), intent(in) :: instance
select case (homogenization_isostrain_mapping(homID))
associate(prm => param(instance))
select case (prm%mapping)
case (parallel_ID)
avgP = sum(P,3)
dAvgPdAvgF = sum(dPdF,5)
case (average_ID)
avgP = sum(P,3) /real(Ngrains,pReal)
dAvgPdAvgF = sum(dPdF,5)/real(Ngrains,pReal)
avgP = sum(P,3) /real(prm%Nconstituents,pReal)
dAvgPdAvgF = sum(dPdF,5)/real(prm%Nconstituents,pReal)
end select
end associate
end subroutine homogenization_isostrain_averageStressAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of homogenization results for post file inclusion
!--------------------------------------------------------------------------------------------------
pure function homogenization_isostrain_postResults(ip,el,avgP,avgF)
use prec, only: &
pReal
use mesh, only: &
mesh_element, &
mesh_ipCoordinates
use material, only: &
homogenization_typeInstance, &
homogenization_Noutput
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3), intent(in) :: &
avgP, & !< average stress at material point
avgF !< average deformation gradient at material point
real(pReal), dimension(homogenization_isostrain_sizePostResults &
(homogenization_typeInstance(mesh_element(3,el)))) :: &
homogenization_isostrain_postResults
integer(pInt) :: &
homID, &
o, c
c = 0_pInt
homID = homogenization_typeInstance(mesh_element(3,el))
homogenization_isostrain_postResults = 0.0_pReal
do o = 1_pInt,homogenization_Noutput(mesh_element(3,el))
select case(homogenization_isostrain_outputID(o,homID))
case (nconstituents_ID)
homogenization_isostrain_postResults(c+1_pInt) = real(homogenization_isostrain_Ngrains(homID),pReal)
c = c + 1_pInt
case (avgdefgrad_ID)
homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgF),[9])
c = c + 9_pInt
case (avgfirstpiola_ID)
homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgP),[9])
c = c + 9_pInt
case (ipcoords_ID)
homogenization_isostrain_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el) ! current ip coordinates
c = c + 3_pInt
end select
enddo
end function homogenization_isostrain_postResults
end module homogenization_isostrain

47
src/homogenization_none.f90
View File

@ -2,7 +2,7 @@
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief dummy homogenization homogenization scheme
!> @brief dummy homogenization homogenization scheme for 1 constituent per material point
!--------------------------------------------------------------------------------------------------
module homogenization_none
@ -24,35 +24,46 @@ subroutine homogenization_none_init()
compiler_options
#endif
use prec, only: &
pReal, &
pInt
pInt
use debug, only: &
debug_HOMOGENIZATION, &
debug_level, &
debug_levelBasic
use IO, only: &
IO_timeStamp
use material
use config
use material, only: &
homogenization_type, &
material_homog, &
homogState, &
HOMOGENIZATION_NONE_LABEL, &
HOMOGENIZATION_NONE_ID
implicit none
integer(pInt) :: &
homog, &
Ninstance, &
h, &
NofMyHomog
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
initializeInstances: do homog = 1_pInt, material_Nhomogenization
Ninstance = int(count(homogenization_type == HOMOGENIZATION_NONE_ID),pInt)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
do h = 1_pInt, size(homogenization_type)
if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle
myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then
NofMyHomog = count(material_homog == homog)
homogState(homog)%sizeState = 0_pInt
homogState(homog)%sizePostResults = 0_pInt
allocate(homogState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal)
allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
allocate(homogState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal)
endif myhomog
enddo initializeInstances
NofMyHomog = count(material_homog == h)
homogState(h)%sizeState = 0_pInt
homogState(h)%sizePostResults = 0_pInt
allocate(homogState(h)%state0 (0_pInt,NofMyHomog))
allocate(homogState(h)%subState0(0_pInt,NofMyHomog))
allocate(homogState(h)%state (0_pInt,NofMyHomog))
enddo
end subroutine homogenization_none_init

508
src/hydrogenflux_cahnhilliard.f90
View File

@ -1,508 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for conservative transport of solute hydrogen
!> @details to be done
!--------------------------------------------------------------------------------------------------
module hydrogenflux_cahnhilliard
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
hydrogenflux_cahnhilliard_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
hydrogenflux_cahnhilliard_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
hydrogenflux_cahnhilliard_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
hydrogenflux_cahnhilliard_Noutput !< number of outputs per instance of this damage
real(pReal), parameter, private :: &
kB = 1.3806488e-23_pReal !< Boltzmann constant in J/Kelvin
enum, bind(c)
enumerator :: undefined_ID, &
hydrogenConc_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
hydrogenflux_cahnhilliard_outputID !< ID of each post result output
public :: &
hydrogenflux_cahnhilliard_init, &
hydrogenflux_cahnhilliard_getMobility33, &
hydrogenflux_cahnhilliard_getDiffusion33, &
hydrogenflux_cahnhilliard_getFormationEnergy, &
hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent, &
hydrogenflux_cahnhilliard_getChemPotAndItsTangent, &
hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate, &
hydrogenflux_cahnhilliard_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine hydrogenflux_cahnhilliard_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
hydrogenflux_type, &
hydrogenflux_typeInstance, &
homogenization_Noutput, &
HYDROGENFLUX_cahnhilliard_label, &
HYDROGENFLUX_cahnhilliard_ID, &
material_homog, &
mappingHomogenization, &
hydrogenfluxState, &
hydrogenfluxMapping, &
hydrogenConc, &
hydrogenConcRate, &
hydrogenflux_initialCh
use config, only: &
material_partHomogenization, &
material_partPhase
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(hydrogenflux_cahnhilliard_sizePostResults(maxNinstance), source=0_pInt)
allocate(hydrogenflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(hydrogenflux_cahnhilliard_output (maxval(homogenization_Noutput),maxNinstance))
hydrogenflux_cahnhilliard_output = ''
allocate(hydrogenflux_cahnhilliard_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(hydrogenflux_cahnhilliard_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next homog section
section = section + 1_pInt ! advance homog section counter
cycle ! skip to next line
endif
if (section > 0_pInt ) then; if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = hydrogenflux_typeInstance(section) ! which instance of my hydrogenflux is present homog
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('hydrogenconc')
hydrogenflux_cahnhilliard_Noutput(instance) = hydrogenflux_cahnhilliard_Noutput(instance) + 1_pInt
hydrogenflux_cahnhilliard_outputID(hydrogenflux_cahnhilliard_Noutput(instance),instance) = hydrogenConc_ID
hydrogenflux_cahnhilliard_output(hydrogenflux_cahnhilliard_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
end select
endif; endif
enddo parsingHomog
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
initializeInstances: do section = 1_pInt, size(hydrogenflux_type)
if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then
NofMyHomog=count(material_homog==section)
instance = hydrogenflux_typeInstance(section)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance)
select case(hydrogenflux_cahnhilliard_outputID(o,instance))
case(hydrogenConc_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
hydrogenflux_cahnhilliard_sizePostResult(o,instance) = mySize
hydrogenflux_cahnhilliard_sizePostResults(instance) = hydrogenflux_cahnhilliard_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! allocate state arrays
sizeState = 0_pInt
hydrogenfluxState(section)%sizeState = sizeState
hydrogenfluxState(section)%sizePostResults = hydrogenflux_cahnhilliard_sizePostResults(instance)
allocate(hydrogenfluxState(section)%state0 (sizeState,NofMyHomog))
allocate(hydrogenfluxState(section)%subState0(sizeState,NofMyHomog))
allocate(hydrogenfluxState(section)%state (sizeState,NofMyHomog))
nullify(hydrogenfluxMapping(section)%p)
hydrogenfluxMapping(section)%p => mappingHomogenization(1,:,:)
deallocate(hydrogenConc (section)%p)
deallocate(hydrogenConcRate(section)%p)
allocate (hydrogenConc (section)%p(NofMyHomog), source=hydrogenflux_initialCh(section))
allocate (hydrogenConcRate(section)%p(NofMyHomog), source=0.0_pReal)
endif
enddo initializeInstances
end subroutine hydrogenflux_cahnhilliard_init
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized solute mobility tensor in reference configuration
!--------------------------------------------------------------------------------------------------
function hydrogenflux_cahnhilliard_getMobility33(ip,el)
use lattice, only: &
lattice_hydrogenfluxMobility33
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
use crystallite, only: &
crystallite_push33ToRef
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
hydrogenflux_cahnhilliard_getMobility33
integer(pInt) :: &
grain
hydrogenflux_cahnhilliard_getMobility33 = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
hydrogenflux_cahnhilliard_getMobility33 = hydrogenflux_cahnhilliard_getMobility33 + &
crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxMobility33(:,:,material_phase(grain,ip,el)))
enddo
hydrogenflux_cahnhilliard_getMobility33 = &
hydrogenflux_cahnhilliard_getMobility33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function hydrogenflux_cahnhilliard_getMobility33
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized solute nonlocal diffusion tensor in reference configuration
!--------------------------------------------------------------------------------------------------
function hydrogenflux_cahnhilliard_getDiffusion33(ip,el)
use lattice, only: &
lattice_hydrogenfluxDiffusion33
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
use crystallite, only: &
crystallite_push33ToRef
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
hydrogenflux_cahnhilliard_getDiffusion33
integer(pInt) :: &
grain
hydrogenflux_cahnhilliard_getDiffusion33 = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
hydrogenflux_cahnhilliard_getDiffusion33 = hydrogenflux_cahnhilliard_getDiffusion33 + &
crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxDiffusion33(:,:,material_phase(grain,ip,el)))
enddo
hydrogenflux_cahnhilliard_getDiffusion33 = &
hydrogenflux_cahnhilliard_getDiffusion33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function hydrogenflux_cahnhilliard_getDiffusion33
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized solution energy
!--------------------------------------------------------------------------------------------------
function hydrogenflux_cahnhilliard_getFormationEnergy(ip,el)
use lattice, only: &
lattice_hydrogenFormationEnergy, &
lattice_hydrogenVol, &
lattice_hydrogenSurfaceEnergy
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal) :: &
hydrogenflux_cahnhilliard_getFormationEnergy
integer(pInt) :: &
grain
hydrogenflux_cahnhilliard_getFormationEnergy = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
hydrogenflux_cahnhilliard_getFormationEnergy = hydrogenflux_cahnhilliard_getFormationEnergy + &
lattice_hydrogenFormationEnergy(material_phase(grain,ip,el))/ &
lattice_hydrogenVol(material_phase(grain,ip,el))/ &
lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
enddo
hydrogenflux_cahnhilliard_getFormationEnergy = &
hydrogenflux_cahnhilliard_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function hydrogenflux_cahnhilliard_getFormationEnergy
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized hydrogen entropy coefficient
!--------------------------------------------------------------------------------------------------
function hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el)
use lattice, only: &
lattice_hydrogenVol, &
lattice_hydrogenSurfaceEnergy
use material, only: &
homogenization_Ngrains, &
material_homog, &
material_phase, &
temperature, &
thermalMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal) :: &
hydrogenflux_cahnhilliard_getEntropicCoeff
integer(pInt) :: &
grain
hydrogenflux_cahnhilliard_getEntropicCoeff = 0.0_pReal
do grain = 1, homogenization_Ngrains(material_homog(ip,el))
hydrogenflux_cahnhilliard_getEntropicCoeff = hydrogenflux_cahnhilliard_getEntropicCoeff + &
kB/ &
lattice_hydrogenVol(material_phase(grain,ip,el))/ &
lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
enddo
hydrogenflux_cahnhilliard_getEntropicCoeff = hydrogenflux_cahnhilliard_getEntropicCoeff* &
temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ &
real(homogenization_Ngrains(material_homog(ip,el)),pReal)
end function hydrogenflux_cahnhilliard_getEntropicCoeff
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized kinematic contribution to chemical potential
!--------------------------------------------------------------------------------------------------
subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el)
use lattice, only: &
lattice_hydrogenSurfaceEnergy
use material, only: &
homogenization_Ngrains, &
material_homog, &
phase_kinematics, &
phase_Nkinematics, &
material_phase, &
KINEMATICS_hydrogen_strain_ID
use crystallite, only: &
crystallite_Tstar_v, &
crystallite_Fi0, &
crystallite_Fi
use kinematics_hydrogen_strain, only: &
kinematics_hydrogen_strain_ChemPotAndItsTangent
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Ch
real(pReal), intent(out) :: &
KPot, dKPot_dCh
real(pReal) :: &
my_KPot, my_dKPot_dCh
integer(pInt) :: &
grain, kinematics
KPot = 0.0_pReal
dKPot_dCh = 0.0_pReal
do grain = 1_pInt,homogenization_Ngrains(material_homog(ip,el))
do kinematics = 1_pInt, phase_Nkinematics(material_phase(grain,ip,el))
select case (phase_kinematics(kinematics,material_phase(grain,ip,el)))
case (KINEMATICS_hydrogen_strain_ID)
call kinematics_hydrogen_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCh, &
crystallite_Tstar_v(1:6,grain,ip,el), &
crystallite_Fi0(1:3,1:3,grain,ip,el), &
crystallite_Fi (1:3,1:3,grain,ip,el), &
grain,ip, el)
case default
my_KPot = 0.0_pReal
my_dKPot_dCh = 0.0_pReal
end select
KPot = KPot + my_KPot/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
dKPot_dCh = dKPot_dCh + my_dKPot_dCh/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
enddo
enddo
KPot = KPot/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
dKPot_dCh = dKPot_dCh/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
end subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized chemical potential
!--------------------------------------------------------------------------------------------------
subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCh,Ch,ip,el)
use numerics, only: &
hydrogenBoundPenalty, &
hydrogenPolyOrder
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Ch
real(pReal), intent(out) :: &
ChemPot, &
dChemPot_dCh
real(pReal) :: &
kBT, KPot, dKPot_dCh
integer(pInt) :: &
o
ChemPot = hydrogenflux_cahnhilliard_getFormationEnergy(ip,el)
dChemPot_dCh = 0.0_pReal
kBT = hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el)
do o = 1_pInt, hydrogenPolyOrder
ChemPot = ChemPot + kBT*((2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ &
real(2_pInt*o-1_pInt,pReal)
dChemPot_dCh = dChemPot_dCh + 2.0_pReal*kBT*(2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal)
enddo
call hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el)
ChemPot = ChemPot + KPot
dChemPot_dCh = dChemPot_dCh + dKPot_dCh
if (Ch < 0.0_pReal) then
ChemPot = ChemPot - 3.0_pReal*hydrogenBoundPenalty*Ch*Ch
dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*Ch
elseif (Ch > 1.0_pReal) then
ChemPot = ChemPot + 3.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch)*(1.0_pReal - Ch)
dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch)
endif
end subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief updates hydrogen concentration with solution from Cahn-Hilliard PDE for solute transport
!--------------------------------------------------------------------------------------------------
subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate(Ch,Chdot,ip,el)
use material, only: &
mappingHomogenization, &
hydrogenConc, &
hydrogenConcRate, &
hydrogenfluxMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Ch, &
Chdot
integer(pInt) :: &
homog, &
offset
homog = mappingHomogenization(2,ip,el)
offset = hydrogenfluxMapping(homog)%p(ip,el)
hydrogenConc (homog)%p(offset) = Ch
hydrogenConcRate(homog)%p(offset) = Chdot
end subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate
!--------------------------------------------------------------------------------------------------
!> @brief return array of hydrogen transport results
!--------------------------------------------------------------------------------------------------
function hydrogenflux_cahnhilliard_postResults(ip,el)
use material, only: &
mappingHomogenization, &
hydrogenflux_typeInstance, &
hydrogenConc, &
hydrogenfluxMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(hydrogenflux_cahnhilliard_sizePostResults(hydrogenflux_typeInstance(mappingHomogenization(2,ip,el)))) :: &
hydrogenflux_cahnhilliard_postResults
integer(pInt) :: &
instance, homog, offset, o, c
homog = mappingHomogenization(2,ip,el)
offset = hydrogenfluxMapping(homog)%p(ip,el)
instance = hydrogenflux_typeInstance(homog)
c = 0_pInt
hydrogenflux_cahnhilliard_postResults = 0.0_pReal
do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance)
select case(hydrogenflux_cahnhilliard_outputID(o,instance))
case (hydrogenConc_ID)
hydrogenflux_cahnhilliard_postResults(c+1_pInt) = hydrogenConc(homog)%p(offset)
c = c + 1
end select
enddo
end function hydrogenflux_cahnhilliard_postResults
end module hydrogenflux_cahnhilliard

62
src/hydrogenflux_isoconc.f90
View File

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

263
src/kinematics_hydrogen_strain.f90
View File

@ -1,263 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from interstitial hydrogen
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_hydrogen_strain
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_hydrogen_strain_sizePostResults, & !< cumulative size of post results
kinematics_hydrogen_strain_offset, & !< which kinematics is my current damage mechanism?
kinematics_hydrogen_strain_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_hydrogen_strain_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_hydrogen_strain_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_hydrogen_strain_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
kinematics_hydrogen_strain_coeff
public :: &
kinematics_hydrogen_strain_init, &
kinematics_hydrogen_strain_initialStrain, &
kinematics_hydrogen_strain_LiAndItsTangent, &
kinematics_hydrogen_strain_ChemPotAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_hydrogen_strain_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_hydrogen_strain_label, &
KINEMATICS_hydrogen_strain_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_hydrogen_strain_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_kinematics == KINEMATICS_hydrogen_strain_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_hydrogen_strain_offset(material_Nphase), source=0_pInt)
allocate(kinematics_hydrogen_strain_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_hydrogen_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_hydrogen_strain_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_hydrogen_strain_ID) &
kinematics_hydrogen_strain_offset(phase) = kinematics
enddo
enddo
allocate(kinematics_hydrogen_strain_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_hydrogen_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(kinematics_hydrogen_strain_output(maxval(phase_Noutput),maxNinstance))
kinematics_hydrogen_strain_output = ''
allocate(kinematics_hydrogen_strain_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_hydrogen_strain_coeff(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_hydrogen_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = kinematics_hydrogen_strain_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('hydrogen_strain_coeff')
kinematics_hydrogen_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif; endif
enddo parsingFile
end subroutine kinematics_hydrogen_strain_init
!--------------------------------------------------------------------------------------------------
!> @brief report initial hydrogen strain based on current hydrogen conc deviation from
!> equillibrium (0)
!--------------------------------------------------------------------------------------------------
pure function kinematics_hydrogen_strain_initialStrain(ipc, ip, el)
use math, only: &
math_I3
use material, only: &
material_phase, &
material_homog, &
hydrogenConc, &
hydrogenfluxMapping
use lattice, only: &
lattice_equilibriumHydrogenConcentration
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
kinematics_hydrogen_strain_initialStrain !< initial thermal strain (should be small strain, though)
integer(pInt) :: &
phase, &
homog, offset, instance
phase = material_phase(ipc,ip,el)
instance = kinematics_hydrogen_strain_instance(phase)
homog = material_homog(ip,el)
offset = hydrogenfluxMapping(homog)%p(ip,el)
kinematics_hydrogen_strain_initialStrain = &
(hydrogenConc(homog)%p(offset) - lattice_equilibriumHydrogenConcentration(phase)) * &
kinematics_hydrogen_strain_coeff(instance)* math_I3
end function kinematics_hydrogen_strain_initialStrain
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
subroutine kinematics_hydrogen_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el)
use material, only: &
material_phase, &
material_homog, &
hydrogenConc, &
hydrogenConcRate, &
hydrogenfluxMapping
use math, only: &
math_I3
use lattice, only: &
lattice_equilibriumHydrogenConcentration
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(out), dimension(3,3) :: &
Li !< thermal velocity gradient
real(pReal), intent(out), dimension(3,3,3,3) :: &
dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor)
integer(pInt) :: &
phase, &
instance, &
homog, offset
real(pReal) :: &
Ch, ChEq, ChDot
phase = material_phase(ipc,ip,el)
instance = kinematics_hydrogen_strain_instance(phase)
homog = material_homog(ip,el)
offset = hydrogenfluxMapping(homog)%p(ip,el)
Ch = hydrogenConc(homog)%p(offset)
ChDot = hydrogenConcRate(homog)%p(offset)
ChEq = lattice_equilibriumHydrogenConcentration(phase)
Li = ChDot*math_I3* &
kinematics_hydrogen_strain_coeff(instance)/ &
(1.0_pReal + kinematics_hydrogen_strain_coeff(instance)*(Ch - ChEq))
dLi_dTstar3333 = 0.0_pReal
end subroutine kinematics_hydrogen_strain_LiAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief contains the kinematic contribution to hydrogen chemical potential
!--------------------------------------------------------------------------------------------------
subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCh, Tstar_v, Fi0, Fi, ipc, ip, el)
use material, only: &
material_phase
use math, only: &
math_inv33, &
math_mul33x33, &
math_Mandel6to33, &
math_transpose33
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(in), dimension(6) :: &
Tstar_v
real(pReal), intent(in), dimension(3,3) :: &
Fi0, Fi
real(pReal), intent(out) :: &
ChemPot, dChemPot_dCh
integer(pInt) :: &
phase, &
instance
phase = material_phase(ipc,ip,el)
instance = kinematics_hydrogen_strain_instance(phase)
ChemPot = -kinematics_hydrogen_strain_coeff(instance)* &
sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* &
math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi))
dChemPot_dCh = 0.0_pReal
end subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent
end module kinematics_hydrogen_strain

264
src/kinematics_vacancy_strain.f90
View File

@ -1,264 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from vacancy point defects
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_vacancy_strain
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_vacancy_strain_sizePostResults, & !< cumulative size of post results
kinematics_vacancy_strain_offset, & !< which kinematics is my current damage mechanism?
kinematics_vacancy_strain_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_vacancy_strain_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_vacancy_strain_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_vacancy_strain_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
kinematics_vacancy_strain_coeff
public :: &
kinematics_vacancy_strain_init, &
kinematics_vacancy_strain_initialStrain, &
kinematics_vacancy_strain_LiAndItsTangent, &
kinematics_vacancy_strain_ChemPotAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_vacancy_strain_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_vacancy_strain_label, &
KINEMATICS_vacancy_strain_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_vacancy_strain_offset(material_Nphase), source=0_pInt)
allocate(kinematics_vacancy_strain_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_vacancy_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_vacancy_strain_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_vacancy_strain_ID) &
kinematics_vacancy_strain_offset(phase) = kinematics
enddo
enddo
allocate(kinematics_vacancy_strain_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_vacancy_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(kinematics_vacancy_strain_output(maxval(phase_Noutput),maxNinstance))
kinematics_vacancy_strain_output = ''
allocate(kinematics_vacancy_strain_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_vacancy_strain_coeff(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_vacancy_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = kinematics_vacancy_strain_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('vacancy_strain_coeff')
kinematics_vacancy_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif; endif
enddo parsingFile
end subroutine kinematics_vacancy_strain_init
!--------------------------------------------------------------------------------------------------
!> @brief report initial vacancy strain based on current vacancy conc deviation from equillibrium
!--------------------------------------------------------------------------------------------------
pure function kinematics_vacancy_strain_initialStrain(ipc, ip, el)
use math, only: &
math_I3
use material, only: &
material_phase, &
material_homog, &
vacancyConc, &
vacancyfluxMapping
use lattice, only: &
lattice_equilibriumVacancyConcentration
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
kinematics_vacancy_strain_initialStrain !< initial thermal strain (should be small strain, though)
integer(pInt) :: &
phase, &
homog, offset, instance
phase = material_phase(ipc,ip,el)
instance = kinematics_vacancy_strain_instance(phase)
homog = material_homog(ip,el)
offset = vacancyfluxMapping(homog)%p(ip,el)
kinematics_vacancy_strain_initialStrain = &
(vacancyConc(homog)%p(offset) - lattice_equilibriumVacancyConcentration(phase)) * &
kinematics_vacancy_strain_coeff(instance)* math_I3
end function kinematics_vacancy_strain_initialStrain
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
subroutine kinematics_vacancy_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el)
use material, only: &
material_phase, &
material_homog, &
vacancyConc, &
vacancyConcRate, &
vacancyfluxMapping
use math, only: &
math_I3
use lattice, only: &
lattice_equilibriumVacancyConcentration
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(out), dimension(3,3) :: &
Li !< thermal velocity gradient
real(pReal), intent(out), dimension(3,3,3,3) :: &
dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor)
integer(pInt) :: &
phase, &
instance, &
homog, offset
real(pReal) :: &
Cv, CvEq, CvDot
phase = material_phase(ipc,ip,el)
instance = kinematics_vacancy_strain_instance(phase)
homog = material_homog(ip,el)
offset = vacancyfluxMapping(homog)%p(ip,el)
Cv = vacancyConc(homog)%p(offset)
CvDot = vacancyConcRate(homog)%p(offset)
CvEq = lattice_equilibriumvacancyConcentration(phase)
Li = CvDot*math_I3* &
kinematics_vacancy_strain_coeff(instance)/ &
(1.0_pReal + kinematics_vacancy_strain_coeff(instance)*(Cv - CvEq))
dLi_dTstar3333 = 0.0_pReal
end subroutine kinematics_vacancy_strain_LiAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief contains the kinematic contribution to vacancy chemical potential
!--------------------------------------------------------------------------------------------------
subroutine kinematics_vacancy_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCv, Tstar_v, Fi0, Fi, ipc, ip, el)
use material, only: &
material_phase
use math, only: &
math_inv33, &
math_mul33x33, &
math_Mandel6to33, &
math_transpose33
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(in), dimension(6) :: &
Tstar_v
real(pReal), intent(in), dimension(3,3) :: &
Fi0, Fi
real(pReal), intent(out) :: &
ChemPot, dChemPot_dCv
integer(pInt) :: &
phase, &
instance
phase = material_phase(ipc,ip,el)
instance = kinematics_vacancy_strain_instance(phase)
ChemPot = -kinematics_vacancy_strain_coeff(instance)* &
sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* &
math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi))
dChemPot_dCv = 0.0_pReal
end subroutine kinematics_vacancy_strain_ChemPotAndItsTangent
end module kinematics_vacancy_strain

2371
src/lattice.f90
View File

File diff suppressed because it is too large Load Diff

190
src/material.f90
View File

@ -36,29 +36,16 @@ module material
SOURCE_damage_isoDuctile_label = 'damage_isoductile', &
SOURCE_damage_anisoBrittle_label = 'damage_anisobrittle', &
SOURCE_damage_anisoDuctile_label = 'damage_anisoductile', &
SOURCE_vacancy_phenoplasticity_label = 'vacancy_phenoplasticity', &
SOURCE_vacancy_irradiation_label = 'vacancy_irradiation', &
SOURCE_vacancy_thermalfluc_label = 'vacancy_thermalfluctuation', &
KINEMATICS_thermal_expansion_label = 'thermal_expansion', &
KINEMATICS_cleavage_opening_label = 'cleavage_opening', &
KINEMATICS_slipplane_opening_label = 'slipplane_opening', &
KINEMATICS_vacancy_strain_label = 'vacancy_strain', &
KINEMATICS_hydrogen_strain_label = 'hydrogen_strain', &
STIFFNESS_DEGRADATION_damage_label = 'damage', &
STIFFNESS_DEGRADATION_porosity_label = 'porosity', &
THERMAL_isothermal_label = 'isothermal', &
THERMAL_adiabatic_label = 'adiabatic', &
THERMAL_conduction_label = 'conduction', &
DAMAGE_none_label = 'none', &
DAMAGE_local_label = 'local', &
DAMAGE_nonlocal_label = 'nonlocal', &
VACANCYFLUX_isoconc_label = 'isoconcentration', &
VACANCYFLUX_isochempot_label = 'isochemicalpotential', &
VACANCYFLUX_cahnhilliard_label = 'cahnhilliard', &
POROSITY_none_label = 'none', &
POROSITY_phasefield_label = 'phasefield', &
HYDROGENFLUX_isoconc_label = 'isoconcentration', &
HYDROGENFLUX_cahnhilliard_label = 'cahnhilliard', &
HOMOGENIZATION_none_label = 'none', &
HOMOGENIZATION_isostrain_label = 'isostrain', &
HOMOGENIZATION_rgc_label = 'rgc'
@ -87,25 +74,19 @@ module material
SOURCE_damage_isoBrittle_ID, &
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID, &
SOURCE_vacancy_phenoplasticity_ID, &
SOURCE_vacancy_irradiation_ID, &
SOURCE_vacancy_thermalfluc_ID
SOURCE_damage_anisoDuctile_ID
end enum
enum, bind(c)
enumerator :: KINEMATICS_undefined_ID, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_thermal_expansion_ID, &
KINEMATICS_vacancy_strain_ID, &
KINEMATICS_hydrogen_strain_ID
KINEMATICS_thermal_expansion_ID
end enum
enum, bind(c)
enumerator :: STIFFNESS_DEGRADATION_undefined_ID, &
STIFFNESS_DEGRADATION_damage_ID, &
STIFFNESS_DEGRADATION_porosity_ID
STIFFNESS_DEGRADATION_damage_ID
end enum
enum, bind(c)
@ -120,21 +101,6 @@ module material
DAMAGE_nonlocal_ID
end enum
enum, bind(c)
enumerator :: VACANCYFLUX_isoconc_ID, &
VACANCYFLUX_isochempot_ID, &
VACANCYFLUX_cahnhilliard_ID
end enum
enum, bind(c)
enumerator :: POROSITY_none_ID, &
POROSITY_phasefield_ID
end enum
enum, bind(c)
enumerator :: HYDROGENFLUX_isoconc_ID, &
HYDROGENFLUX_cahnhilliard_ID
end enum
enum, bind(c)
enumerator :: HOMOGENIZATION_undefined_ID, &
HOMOGENIZATION_none_ID, &
@ -150,12 +116,6 @@ module material
thermal_type !< thermal transport model
integer(kind(DAMAGE_none_ID)), dimension(:), allocatable, public, protected :: &
damage_type !< nonlocal damage model
integer(kind(VACANCYFLUX_isoconc_ID)), dimension(:), allocatable, public, protected :: &
vacancyflux_type !< vacancy transport model
integer(kind(POROSITY_none_ID)), dimension(:), allocatable, public, protected :: &
porosity_type !< porosity evolution model
integer(kind(HYDROGENFLUX_isoconc_ID)), dimension(:), allocatable, public, protected :: &
hydrogenflux_type !< hydrogen transport model
integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable, public, protected :: &
phase_source, & !< active sources mechanisms of each phase
@ -181,17 +141,11 @@ module material
homogenization_typeInstance, & !< instance of particular type of each homogenization
thermal_typeInstance, & !< instance of particular type of each thermal transport
damage_typeInstance, & !< instance of particular type of each nonlocal damage
vacancyflux_typeInstance, & !< instance of particular type of each vacancy flux
porosity_typeInstance, & !< instance of particular type of each porosity model
hydrogenflux_typeInstance, & !< instance of particular type of each hydrogen flux
microstructure_crystallite !< crystallite setting ID of each microstructure ! DEPRECATED !!!!
real(pReal), dimension(:), allocatable, public, protected :: &
thermal_initialT, & !< initial temperature per each homogenization
damage_initialPhi, & !< initial damage per each homogenization
vacancyflux_initialCv, & !< initial vacancy concentration per each homogenization
porosity_initialPhi, & !< initial posority per each homogenization
hydrogenflux_initialCh !< initial hydrogen concentration per each homogenization
damage_initialPhi !< initial damage per each homogenization
! NEW MAPPINGS
integer(pInt), dimension(:), allocatable, public, protected :: &
@ -221,10 +175,7 @@ module material
type(tState), allocatable, dimension(:), public :: &
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
porosityState, &
hydrogenfluxState
damageState
integer(pInt), dimension(:,:,:), allocatable, public, protected :: &
material_texture !< texture (index) of each grain,IP,element
@ -274,20 +225,12 @@ module material
type(tHomogMapping), allocatable, dimension(:), public :: &
thermalMapping, & !< mapping for thermal state/fields
damageMapping, & !< mapping for damage state/fields
vacancyfluxMapping, & !< mapping for vacancy conc state/fields
porosityMapping, & !< mapping for porosity state/fields
hydrogenfluxMapping !< mapping for hydrogen conc state/fields
damageMapping !< mapping for damage state/fields
type(group_float), allocatable, dimension(:), public :: &
temperature, & !< temperature field
damage, & !< damage field
vacancyConc, & !< vacancy conc field
porosity, & !< porosity field
hydrogenConc, & !< hydrogen conc field
temperatureRate, & !< temperature change rate field
vacancyConcRate, & !< vacancy conc change field
hydrogenConcRate !< hydrogen conc change field
temperatureRate !< temperature change rate field
public :: &
material_init, &
@ -306,29 +249,16 @@ module material
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID, &
SOURCE_vacancy_phenoplasticity_ID, &
SOURCE_vacancy_irradiation_ID, &
SOURCE_vacancy_thermalfluc_ID, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_thermal_expansion_ID, &
KINEMATICS_vacancy_strain_ID, &
KINEMATICS_hydrogen_strain_ID, &
STIFFNESS_DEGRADATION_damage_ID, &
STIFFNESS_DEGRADATION_porosity_ID, &
THERMAL_isothermal_ID, &
THERMAL_adiabatic_ID, &
THERMAL_conduction_ID, &
DAMAGE_none_ID, &
DAMAGE_local_ID, &
DAMAGE_nonlocal_ID, &
VACANCYFLUX_isoconc_ID, &
VACANCYFLUX_isochempot_ID, &
VACANCYFLUX_cahnhilliard_ID, &
POROSITY_none_ID, &
POROSITY_phasefield_ID, &
HYDROGENFLUX_isoconc_ID, &
HYDROGENFLUX_cahnhilliard_ID, &
HOMOGENIZATION_none_ID, &
HOMOGENIZATION_isostrain_ID, &
HOMOGENIZATION_RGC_ID
@ -397,19 +327,19 @@ subroutine material_init()
#include "compilation_info.f90"
call material_parsePhase()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
call material_parseMicrostructure()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
call material_parseCrystallite()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
call material_parseHomogenization()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
call material_parseTexture()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
allocate(plasticState (size(config_phase)))
allocate(sourceState (size(config_phase)))
@ -420,25 +350,14 @@ subroutine material_init()
allocate(homogState (size(config_homogenization)))
allocate(thermalState (size(config_homogenization)))
allocate(damageState (size(config_homogenization)))
allocate(vacancyfluxState (size(config_homogenization)))
allocate(porosityState (size(config_homogenization)))
allocate(hydrogenfluxState (size(config_homogenization)))
allocate(thermalMapping (size(config_homogenization)))
allocate(damageMapping (size(config_homogenization)))
allocate(vacancyfluxMapping (size(config_homogenization)))
allocate(porosityMapping (size(config_homogenization)))
allocate(hydrogenfluxMapping(size(config_homogenization)))
allocate(temperature (size(config_homogenization)))
allocate(damage (size(config_homogenization)))
allocate(vacancyConc (size(config_homogenization)))
allocate(porosity (size(config_homogenization)))
allocate(hydrogenConc (size(config_homogenization)))
allocate(temperatureRate (size(config_homogenization)))
allocate(vacancyConcRate (size(config_homogenization)))
allocate(hydrogenConcRate (size(config_homogenization)))
do m = 1_pInt,size(config_microstructure)
if(microstructure_crystallite(m) < 1_pInt .or. &
@ -511,17 +430,9 @@ subroutine material_init()
do myHomog = 1,size(config_homogenization)
thermalMapping (myHomog)%p => mappingHomogenizationConst
damageMapping (myHomog)%p => mappingHomogenizationConst
vacancyfluxMapping (myHomog)%p => mappingHomogenizationConst
porosityMapping (myHomog)%p => mappingHomogenizationConst
hydrogenfluxMapping(myHomog)%p => mappingHomogenizationConst
allocate(temperature (myHomog)%p(1), source=thermal_initialT(myHomog))
allocate(damage (myHomog)%p(1), source=damage_initialPhi(myHomog))
allocate(vacancyConc (myHomog)%p(1), source=vacancyflux_initialCv(myHomog))
allocate(porosity (myHomog)%p(1), source=porosity_initialPhi(myHomog))
allocate(hydrogenConc (myHomog)%p(1), source=hydrogenflux_initialCh(myHomog))
allocate(temperatureRate (myHomog)%p(1), source=0.0_pReal)
allocate(vacancyConcRate (myHomog)%p(1), source=0.0_pReal)
allocate(hydrogenConcRate(myHomog)%p(1), source=0.0_pReal)
enddo
end subroutine material_init
@ -545,23 +456,14 @@ subroutine material_parseHomogenization
allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID)
allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID)
allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID)
allocate(vacancyflux_type(size(config_homogenization)), source=VACANCYFLUX_isoconc_ID)
allocate(porosity_type (size(config_homogenization)), source=POROSITY_none_ID)
allocate(hydrogenflux_type(size(config_homogenization)), source=HYDROGENFLUX_isoconc_ID)
allocate(homogenization_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(thermal_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(damage_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(vacancyflux_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(porosity_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(hydrogenflux_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(homogenization_Ngrains(size(config_homogenization)), source=0_pInt)
allocate(homogenization_Noutput(size(config_homogenization)), source=0_pInt)
allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!!
allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal)
allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal)
allocate(vacancyflux_initialCv(size(config_homogenization)), source=0.0_pReal)
allocate(porosity_initialPhi(size(config_homogenization)), source=1.0_pReal)
allocate(hydrogenflux_initialCh(size(config_homogenization)), source=0.0_pReal)
forall (h = 1_pInt:size(config_homogenization)) &
homogenization_active(h) = any(mesh_homogenizationAt == h)
@ -620,53 +522,6 @@ subroutine material_parseHomogenization
end select
endif
if (config_homogenization(h)%keyExists('vacancyflux')) then
vacancyflux_initialCv(h) = config_homogenization(h)%getFloat('cv0',defaultVal=0.0_pReal)
tag = config_homogenization(h)%getString('vacancyflux')
select case (trim(tag))
case(VACANCYFLUX_isoconc_label)
vacancyflux_type(h) = VACANCYFLUX_isoconc_ID
case(VACANCYFLUX_isochempot_label)
vacancyflux_type(h) = VACANCYFLUX_isochempot_ID
case(VACANCYFLUX_cahnhilliard_label)
vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (config_homogenization(h)%keyExists('porosity')) then
!ToDo?
tag = config_homogenization(h)%getString('porosity')
select case (trim(tag))
case(POROSITY_NONE_label)
porosity_type(h) = POROSITY_none_ID
case(POROSITY_phasefield_label)
porosity_type(h) = POROSITY_phasefield_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (config_homogenization(h)%keyExists('hydrogenflux')) then
hydrogenflux_initialCh(h) = config_homogenization(h)%getFloat('ch0',defaultVal=0.0_pReal)
tag = config_homogenization(h)%getString('hydrogenflux')
select case (trim(tag))
case(HYDROGENFLUX_isoconc_label)
hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID
case(HYDROGENFLUX_cahnhilliard_label)
hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
enddo
@ -674,9 +529,6 @@ subroutine material_parseHomogenization
homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h))
thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h))
damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h))
vacancyflux_typeInstance(h) = count(vacancyflux_type (1:h) == vacancyflux_type (h))
porosity_typeInstance(h) = count(porosity_type (1:h) == porosity_type (h))
hydrogenflux_typeInstance(h) = count(hydrogenflux_type (1:h) == hydrogenflux_type (h))
enddo
homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active)
@ -866,12 +718,6 @@ subroutine material_parsePhase
phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID
case (SOURCE_damage_anisoDuctile_label)
phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID
case (SOURCE_vacancy_phenoplasticity_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID
case (SOURCE_vacancy_irradiation_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID
case (SOURCE_vacancy_thermalfluc_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID
end select
enddo
@ -890,10 +736,6 @@ subroutine material_parsePhase
phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID
case (KINEMATICS_thermal_expansion_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID
case (KINEMATICS_vacancy_strain_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID
case (KINEMATICS_hydrogen_strain_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID
end select
enddo
#if defined(__GFORTRAN__)
@ -907,8 +749,6 @@ subroutine material_parsePhase
select case (trim(str(stiffDegradationCtr)))
case (STIFFNESS_DEGRADATION_damage_label)
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID
case (STIFFNESS_DEGRADATION_porosity_label)
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID
end select
enddo
enddo
@ -1078,7 +918,8 @@ end subroutine material_parseTexture
!--------------------------------------------------------------------------------------------------
!> @brief allocates the plastic state of a phase
!--------------------------------------------------------------------------------------------------
subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState,&
subroutine material_allocatePlasticState(phase,NofMyPhase,&
sizeState,sizeDotState,sizeDeltaState,&
Nslip,Ntwin,Ntrans)
use numerics, only: &
numerics_integrator2 => numerics_integrator ! compatibility hack
@ -1096,9 +937,10 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState
integer(pInt) :: numerics_integrator ! compatibility hack
numerics_integrator = numerics_integrator2(1) ! compatibility hack
plasticState(phase)%sizeState = sizeState
plasticState(phase)%sizeDotState = sizeDotState
plasticState(phase)%sizeDeltaState = sizeDeltaState
plasticState(phase)%sizeState = sizeState
plasticState(phase)%sizeDotState = sizeDotState
plasticState(phase)%sizeDeltaState = sizeDeltaState
plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition
plasticState(phase)%Nslip = Nslip
plasticState(phase)%Ntwin = Ntwin
plasticState(phase)%Ntrans= Ntrans

551
src/math.f90
View File

@ -24,25 +24,25 @@ module math
0.0_pReal,0.0_pReal,1.0_pReal &
],[3,3]) !< 3x3 Identity
real(pReal), dimension(6), parameter, private :: &
nrmMandel = [&
1.0_pReal, 1.0_pReal, 1.0_pReal, &
sqrt(2.0_pReal), sqrt(2.0_pReal), sqrt(2.0_pReal) ] !< weighting for Mandel notation (forward)
real(pReal), dimension(6), parameter , private :: &
invnrmMandel = [&
1.0_pReal, 1.0_pReal, 1.0_pReal, &
1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal) ] !< weighting for Mandel notation (backward)
integer(pInt), dimension (2,6), parameter, private :: &
mapMandel = reshape([&
mapNye = reshape([&
1_pInt,1_pInt, &
2_pInt,2_pInt, &
3_pInt,3_pInt, &
1_pInt,2_pInt, &
2_pInt,3_pInt, &
1_pInt,3_pInt &
],[2,6]) !< arrangement in Mandel notation
real(pReal), dimension(6), parameter, private :: &
nrmMandel = [&
1.0_pReal, 1.0_pReal, 1.0_pReal, &
sqrt(2.0_pReal), sqrt(2.0_pReal), sqrt(2.0_pReal) ] !< weighting for Mandel notation (forward)
real(pReal), dimension(6), parameter , public :: &
invnrmMandel = [&
1.0_pReal, 1.0_pReal, 1.0_pReal, &
1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal) ] !< weighting for Mandel notation (backward)
],[2,6]) !< arrangement in Nye notation.
integer(pInt), dimension (2,6), parameter, private :: &
mapVoigt = reshape([&
@ -54,10 +54,6 @@ module math
1_pInt,2_pInt &
],[2,6]) !< arrangement in Voigt notation
real(pReal), dimension(6), parameter, private :: &
nrmVoigt = 1.0_pReal, & !< weighting for Voigt notation (forward)
invnrmVoigt = 1.0_pReal !< weighting for Voigt notation (backward)
integer(pInt), dimension (2,9), parameter, private :: &
mapPlain = reshape([&
1_pInt,1_pInt, &
@ -70,8 +66,61 @@ module math
3_pInt,2_pInt, &
3_pInt,3_pInt &
],[2,9]) !< arrangement in Plain notation
!--------------------------------------------------------------------------------------------------
! Provide deprecated names for compatibility
! ToDo MD: Our naming scheme was a little bit odd: We use essentially the re-ordering according to Nye
! (convenient because Abaqus and Marc want to have 12 on position 4)
! but weight the shear components according to Mandel (convenient for matrix multiplications)
interface math_Plain33to9
module procedure math_33to9
end interface math_Plain33to9
interface math_Plain9to33
module procedure math_9to33
end interface math_Plain9to33
interface math_Mandel33to6
module procedure math_sym33to6
end interface math_Mandel33to6
interface math_Mandel6to33
module procedure math_6toSym33
end interface math_Mandel6to33
interface math_Plain3333to99
module procedure math_3333to99
end interface math_Plain3333to99
interface math_Plain99to3333
module procedure math_99to3333
end interface math_Plain99to3333
interface math_Mandel3333to66
module procedure math_sym3333to66
end interface math_Mandel3333to66
interface math_Mandel66to3333
module procedure math_66toSym3333
end interface math_Mandel66to3333
public :: &
math_Plain33to9, &
math_Plain9to33, &
math_Mandel33to6, &
math_Mandel6to33, &
math_Plain3333to99, &
math_Plain99to3333, &
math_Mandel3333to66, &
math_Mandel66to3333
!---------------------------------------------------------------------------------------------------
public :: &
#if defined(__PGI)
norm2, &
#endif
math_init, &
math_qsort, &
math_expand, &
@ -99,6 +148,7 @@ module math
math_invert33, &
math_invSym3333, &
math_invert, &
math_invert2, &
math_symmetric33, &
math_symmetric66, &
math_skew33, &
@ -108,16 +158,14 @@ module math
math_equivStress33, &
math_trace33, &
math_det33, &
math_Plain33to9, &
math_Plain9to33, &
math_Mandel33to6, &
math_Mandel6to33, &
math_Plain3333to99, &
math_Plain99to3333, &
math_Mandel66toPlain66, &
math_Plain66toMandel66, &
math_Mandel3333to66, &
math_Mandel66to3333, &
math_33to9, &
math_9to33, &
math_sym33to6, &
math_6toSym33, &
math_3333to99, &
math_99to3333, &
math_sym3333to66, &
math_66toSym3333, &
math_Voigt66to3333, &
math_qRand, &
math_qMul, &
@ -306,20 +354,38 @@ end subroutine math_check
!--------------------------------------------------------------------------------------------------
!> @brief Quicksort algorithm for two-dimensional integer arrays
! Sorting is done with respect to array(1,:)
! and keeps array(2:N,:) linked to it.
! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it.
! default: sort=1
!--------------------------------------------------------------------------------------------------
recursive subroutine math_qsort(a, istart, iend)
recursive subroutine math_qsort(a, istart, iend, sortDim)
implicit none
integer(pInt), dimension(:,:), intent(inout) :: a
integer(pInt), intent(in) :: istart,iend
integer(pInt) :: ipivot
if (istart < iend) then
ipivot = qsort_partition(a,istart, iend)
call math_qsort(a, istart, ipivot-1_pInt)
call math_qsort(a, ipivot+1_pInt, iend)
integer(pInt), intent(in),optional :: istart,iend, sortDim
integer(pInt) :: ipivot,s,e,d
if(present(istart)) then
s = istart
else
s = lbound(a,2)
endif
if(present(iend)) then
e = iend
else
e = ubound(a,2)
endif
if(present(sortDim)) then
d = sortDim
else
d = 1
endif
if (s < e) then
ipivot = qsort_partition(a,s, e, d)
call math_qsort(a, s, ipivot-1_pInt, d)
call math_qsort(a, ipivot+1_pInt, e, d)
endif
!--------------------------------------------------------------------------------------------------
@ -328,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend)
!-------------------------------------------------------------------------------------------------
!> @brief Partitioning required for quicksort
!-------------------------------------------------------------------------------------------------
integer(pInt) function qsort_partition(a, istart, iend)
integer(pInt) function qsort_partition(a, istart, iend, sort)
implicit none
integer(pInt), dimension(:,:), intent(inout) :: a
integer(pInt), intent(in) :: istart,iend
integer(pInt) :: i,j,k,tmp
integer(pInt), intent(in) :: istart,iend,sort
integer(pInt), dimension(size(a,1)) :: tmp
integer(pInt) :: i,j
do
! find the first element on the right side less than or equal to the pivot point
! find the first element on the right side less than or equal to the pivot point
do j = iend, istart, -1_pInt
if (a(1,j) <= a(1,istart)) exit
if (a(sort,j) <= a(sort,istart)) exit
enddo
! find the first element on the left side greater than the pivot point
! find the first element on the left side greater than the pivot point
do i = istart, iend
if (a(1,i) > a(1,istart)) exit
if (a(sort,i) > a(sort,istart)) exit
enddo
if (i < j) then ! if the indexes do not cross, exchange values
do k = 1_pInt, int(size(a,1_pInt), pInt)
tmp = a(k,i)
a(k,i) = a(k,j)
a(k,j) = tmp
enddo
else ! if they do cross, exchange left value with pivot and return with the partition index
do k = 1_pInt, int(size(a,1_pInt), pInt)
tmp = a(k,istart)
a(k,istart) = a(k,j)
a(k,j) = tmp
enddo
cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index
tmp = a(:,istart)
a(:,istart) = a(:,j)
a(:,j) = tmp
qsort_partition = j
return
endif
else cross ! if they do not cross, exchange values
tmp = a(:,i)
a(:,i) = a(:,j)
a(:,j) = tmp
endif cross
enddo
end function qsort_partition
@ -415,7 +478,7 @@ pure function math_identity2nd(dimen)
real(pReal), dimension(dimen,dimen) :: math_identity2nd
math_identity2nd = 0.0_pReal
forall (i=1_pInt:dimen) math_identity2nd(i,i) = 1.0_pReal
forall(i=1_pInt:dimen) math_identity2nd(i,i) = 1.0_pReal
end function math_identity2nd
@ -429,9 +492,11 @@ pure function math_identity4th(dimen)
integer(pInt), intent(in) :: dimen !< tensor dimension
integer(pInt) :: i,j,k,l
real(pReal), dimension(dimen,dimen,dimen,dimen) :: math_identity4th
real(pReal), dimension(dimen,dimen) :: identity2nd
forall (i=1_pInt:dimen,j=1_pInt:dimen,k=1_pInt:dimen,l=1_pInt:dimen) math_identity4th(i,j,k,l) = &
0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
identity2nd = math_identity2nd(dimen)
forall(i=1_pInt:dimen,j=1_pInt:dimen,k=1_pInt:dimen,l=1_pInt:dimen) &
math_identity4th(i,j,k,l) = 0.5_pReal*(identity2nd(i,k)*identity2nd(j,l)+identity2nd(i,l)*identity2nd(j,k))
end function math_identity4th
@ -500,7 +565,7 @@ pure function math_tensorproduct(A,B)
real(pReal), dimension(size(A,1),size(B,1)) :: math_tensorproduct
integer(pInt) :: i,j
forall (i=1_pInt:size(A,1),j=1_pInt:size(B,1)) math_tensorproduct(i,j) = A(i)*B(j)
forall(i=1_pInt:size(A,1),j=1_pInt:size(B,1)) math_tensorproduct(i,j) = A(i)*B(j)
end function math_tensorproduct
@ -515,7 +580,7 @@ pure function math_tensorproduct33(A,B)
real(pReal), dimension(3), intent(in) :: A,B
integer(pInt) :: i,j
forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_tensorproduct33(i,j) = A(i)*B(j)
forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_tensorproduct33(i,j) = A(i)*B(j)
end function math_tensorproduct33
@ -556,7 +621,7 @@ real(pReal) pure function math_mul33xx33(A,B)
integer(pInt) :: i,j
real(pReal), dimension(3,3) :: C
forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) C(i,j) = A(i,j) * B(i,j)
forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) C(i,j) = A(i,j) * B(i,j)
math_mul33xx33 = sum(C)
end function math_mul33xx33
@ -573,9 +638,8 @@ pure function math_mul3333xx33(A,B)
real(pReal), dimension(3,3), intent(in) :: B
integer(pInt) :: i,j
forall(i = 1_pInt:3_pInt,j = 1_pInt:3_pInt) &
math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3))
forall(i = 1_pInt:3_pInt,j = 1_pInt:3_pInt) math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3))
end function math_mul3333xx33
@ -606,8 +670,7 @@ pure function math_mul33x33(A,B)
real(pReal), dimension(3,3), intent(in) :: A,B
integer(pInt) :: i,j
forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) &
math_mul33x33(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j)
forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_mul33x33(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j)
end function math_mul33x33
@ -622,9 +685,9 @@ pure function math_mul66x66(A,B)
real(pReal), dimension(6,6), intent(in) :: A,B
integer(pInt) :: i,j
forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) math_mul66x66(i,j) = &
A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) + &
A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j)
forall(i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
math_mul66x66(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) &
+ A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j)
end function math_mul66x66
@ -639,10 +702,10 @@ pure function math_mul99x99(A,B)
real(pReal), dimension(9,9), intent(in) :: A,B
integer(pInt) i,j
forall (i=1_pInt:9_pInt,j=1_pInt:9_pInt) math_mul99x99(i,j) = &
A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) + &
A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j) + &
A(i,7)*B(7,j) + A(i,8)*B(8,j) + A(i,9)*B(9,j)
forall(i=1_pInt:9_pInt,j=1_pInt:9_pInt) &
math_mul99x99(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) &
+ A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j) &
+ A(i,7)*B(7,j) + A(i,8)*B(8,j) + A(i,9)*B(9,j)
end function math_mul99x99
@ -690,9 +753,8 @@ pure function math_mul66x6(A,B)
real(pReal), dimension(6), intent(in) :: B
integer(pInt) :: i
forall (i=1_pInt:6_pInt) math_mul66x6(i) = &
A(i,1)*B(1) + A(i,2)*B(2) + A(i,3)*B(3) + &
A(i,4)*B(4) + A(i,5)*B(5) + A(i,6)*B(6)
forall (i=1_pInt:6_pInt) math_mul66x6(i) = A(i,1)*B(1) + A(i,2)*B(2) + A(i,3)*B(3) &
+ A(i,4)*B(4) + A(i,5)*B(5) + A(i,6)*B(6)
end function math_mul66x6
@ -739,8 +801,8 @@ end function math_transpose33
!--------------------------------------------------------------------------------------------------
!> @brief Cramer inversion of 33 matrix (function)
! direct Cramer inversion of matrix A.
! returns all zeroes if not possible, i.e. if det close to zero
!> @details Direct Cramer inversion of matrix A. Returns all zeroes if not possible, i.e.
! if determinant is close to zero
!--------------------------------------------------------------------------------------------------
pure function math_inv33(A)
use prec, only: &
@ -776,9 +838,9 @@ end function math_inv33
!--------------------------------------------------------------------------------------------------
!> @brief Cramer inversion of 33 matrix (subroutine)
! direct Cramer inversion of matrix A.
! also returns determinant
! returns error if not possible, i.e. if det close to zero
!> @details Direct Cramer inversion of matrix A. Also returns determinant
! Returns an error if not possible, i.e. if determinant is close to zero
! ToDo: Output arguments should be first
!--------------------------------------------------------------------------------------------------
pure subroutine math_invert33(A, InvA, DetA, error)
use prec, only: &
@ -835,11 +897,11 @@ function math_invSym3333(A)
dgetrf, &
dgetri
temp66_real = math_Mandel3333to66(A)
temp66_real = math_sym3333to66(A)
call dgetrf(6,6,temp66_real,6,ipiv6,ierr)
call dgetri(6,temp66_real,6,ipiv6,work6,6,ierr)
if (ierr == 0_pInt) then
math_invSym3333 = math_Mandel66to3333(temp66_real)
math_invSym3333 = math_66toSym3333(temp66_real)
else
call IO_error(400_pInt, ext_msg = 'math_invSym3333')
endif
@ -847,8 +909,27 @@ function math_invSym3333(A)
end function math_invSym3333
!--------------------------------------------------------------------------------------------------
!> @brief invert quadratic matrix of arbitrary dimension
! ToDo: replaces math_invert
!--------------------------------------------------------------------------------------------------
subroutine math_invert2(InvA, error, A)
implicit none
real(pReal), dimension(:,:), intent(in) :: A
real(pReal), dimension(size(A,1),size(A,1)), intent(out) :: invA
logical, intent(out) :: error
call math_invert(size(A,1), A, InvA, error)
end subroutine math_invert2
!--------------------------------------------------------------------------------------------------
!> @brief invert matrix of arbitrary dimension
! ToDo: Wrong order of arguments and superfluous myDim argument.
! Use math_invert2 instead
!--------------------------------------------------------------------------------------------------
subroutine math_invert(myDim,A, InvA, error)
@ -870,7 +951,7 @@ subroutine math_invert(myDim,A, InvA, error)
invA = A
call dgetrf(myDim,myDim,invA,myDim,ipiv,ierr)
call dgetri(myDim,InvA,myDim,ipiv,work,myDim,ierr)
error = merge(.true.,.false., ierr /= 0_pInt) ! http://fortraninacworld.blogspot.de/2012/12/ternary-operator.html
error = merge(.true.,.false., ierr /= 0_pInt)
end subroutine math_invert
@ -953,15 +1034,14 @@ pure function math_equivStrain33(m)
real(pReal), dimension(3,3), intent(in) :: m
real(pReal), dimension(3) :: e,s
real(pReal) :: math_equivStrain33
real(pReal), parameter :: TWOTHIRD = 2.0_pReal/3.0_pReal
e = [2.0_pReal*m(1,1)-m(2,2)-m(3,3), &
2.0_pReal*m(2,2)-m(3,3)-m(1,1), &
2.0_pReal*m(3,3)-m(1,1)-m(2,2)]/3.0_pReal
s = [m(1,2),m(2,3),m(1,3)]*2.0_pReal
math_equivStrain33 = TWOTHIRD*(1.50_pReal*(sum(e**2.0_pReal)) + &
0.75_pReal*(sum(s**2.0_pReal)))**(0.5_pReal)
math_equivStrain33 = 2.0_pReal/3.0_pReal &
* (1.50_pReal*(sum(e**2.0_pReal))+ 0.75_pReal*(sum(s**2.0_pReal)))**(0.5_pReal)
end function math_equivStrain33
@ -1033,173 +1113,188 @@ end function math_detSym33
!--------------------------------------------------------------------------------------------------
!> @brief convert 33 matrix into vector 9
!--------------------------------------------------------------------------------------------------
pure function math_Plain33to9(m33)
pure function math_33to9(m33)
implicit none
real(pReal), dimension(9) :: math_Plain33to9
real(pReal), dimension(3,3), intent(in) :: m33
integer(pInt) :: i
forall (i=1_pInt:9_pInt) math_Plain33to9(i) = m33(mapPlain(1,i),mapPlain(2,i))
end function math_Plain33to9
!--------------------------------------------------------------------------------------------------
!> @brief convert Plain 9 back to 33 matrix
!--------------------------------------------------------------------------------------------------
pure function math_Plain9to33(v9)
implicit none
real(pReal), dimension(3,3) :: math_Plain9to33
real(pReal), dimension(9), intent(in) :: v9
integer(pInt) :: i
forall (i=1_pInt:9_pInt) math_Plain9to33(mapPlain(1,i),mapPlain(2,i)) = v9(i)
end function math_Plain9to33
!--------------------------------------------------------------------------------------------------
!> @brief convert symmetric 33 matrix into Mandel vector 6
!--------------------------------------------------------------------------------------------------
pure function math_Mandel33to6(m33)
implicit none
real(pReal), dimension(6) :: math_Mandel33to6
real(pReal), dimension(9) :: math_33to9
real(pReal), dimension(3,3), intent(in) :: m33
integer(pInt) :: i
forall (i=1_pInt:6_pInt) math_Mandel33to6(i) = nrmMandel(i)*m33(mapMandel(1,i),mapMandel(2,i))
forall(i=1_pInt:9_pInt) math_33to9(i) = m33(mapPlain(1,i),mapPlain(2,i))
end function math_Mandel33to6
end function math_33to9
!--------------------------------------------------------------------------------------------------
!> @brief convert Mandel 6 back to symmetric 33 matrix
!> @brief convert 9 vector into 33 matrix
!--------------------------------------------------------------------------------------------------
pure function math_Mandel6to33(v6)
pure function math_9to33(v9)
implicit none
real(pReal), dimension(6), intent(in) :: v6
real(pReal), dimension(3,3) :: math_Mandel6to33
real(pReal), dimension(3,3) :: math_9to33
real(pReal), dimension(9), intent(in) :: v9
integer(pInt) :: i
forall (i=1_pInt:6_pInt)
math_Mandel6to33(mapMandel(1,i),mapMandel(2,i)) = invnrmMandel(i)*v6(i)
math_Mandel6to33(mapMandel(2,i),mapMandel(1,i)) = invnrmMandel(i)*v6(i)
end forall
forall(i=1_pInt:9_pInt) math_9to33(mapPlain(1,i),mapPlain(2,i)) = v9(i)
end function math_Mandel6to33
end function math_9to33
!--------------------------------------------------------------------------------------------------
!> @brief convert 3333 tensor into plain matrix 99
!> @brief convert symmetric 33 matrix into 6 vector
!> @details Weighted conversion (default) rearranges according to Nye and weights shear
! components according to Mandel. Advisable for matrix operations.
! Unweighted conversion only changes order according to Nye
!--------------------------------------------------------------------------------------------------
pure function math_Plain3333to99(m3333)
pure function math_sym33to6(m33,weighted)
implicit none
real(pReal), dimension(6) :: math_sym33to6
real(pReal), dimension(3,3), intent(in) :: m33
logical, optional, intent(in) :: weighted
real(pReal), dimension(6) :: w
integer(pInt) :: i
if(present(weighted)) then
w = merge(nrmMandel,1.0_pReal,weighted)
else
w = nrmMandel
endif
forall(i=1_pInt:6_pInt) math_sym33to6(i) = w(i)*m33(mapNye(1,i),mapNye(2,i))
end function math_sym33to6
!--------------------------------------------------------------------------------------------------
!> @brief convert 6 vector into symmetric 33 matrix
!> @details Weighted conversion (default) rearranges according to Nye and weights shear
! components according to Mandel. Advisable for matrix operations.
! Unweighted conversion only changes order according to Nye
!--------------------------------------------------------------------------------------------------
pure function math_6toSym33(v6,weighted)
implicit none
real(pReal), dimension(3,3) :: math_6toSym33
real(pReal), dimension(6), intent(in) :: v6
logical, optional, intent(in) :: weighted
real(pReal), dimension(6) :: w
integer(pInt) :: i
if(present(weighted)) then
w = merge(invnrmMandel,1.0_pReal,weighted)
else
w = invnrmMandel
endif
do i=1_pInt,6_pInt
math_6toSym33(mapNye(1,i),mapNye(2,i)) = w(i)*v6(i)
math_6toSym33(mapNye(2,i),mapNye(1,i)) = w(i)*v6(i)
enddo
end function math_6toSym33
!--------------------------------------------------------------------------------------------------
!> @brief convert 3333 matrix into 99 matrix
!--------------------------------------------------------------------------------------------------
pure function math_3333to99(m3333)
implicit none
real(pReal), dimension(9,9) :: math_3333to99
real(pReal), dimension(3,3,3,3), intent(in) :: m3333
real(pReal), dimension(9,9) :: math_Plain3333to99
integer(pInt) :: i,j
forall (i=1_pInt:9_pInt,j=1_pInt:9_pInt) math_Plain3333to99(i,j) = &
m3333(mapPlain(1,i),mapPlain(2,i),mapPlain(1,j),mapPlain(2,j))
forall(i=1_pInt:9_pInt,j=1_pInt:9_pInt) &
math_3333to99(i,j) = m3333(mapPlain(1,i),mapPlain(2,i),mapPlain(1,j),mapPlain(2,j))
end function math_3333to99
end function math_Plain3333to99
!--------------------------------------------------------------------------------------------------
!> @brief plain matrix 99 into 3333 tensor
!> @brief convert 99 matrix into 3333 matrix
!--------------------------------------------------------------------------------------------------
pure function math_Plain99to3333(m99)
pure function math_99to3333(m99)
implicit none
real(pReal), dimension(3,3,3,3) :: math_99to3333
real(pReal), dimension(9,9), intent(in) :: m99
real(pReal), dimension(3,3,3,3) :: math_Plain99to3333
integer(pInt) :: i,j
forall (i=1_pInt:9_pInt,j=1_pInt:9_pInt) math_Plain99to3333(mapPlain(1,i),mapPlain(2,i),&
mapPlain(1,j),mapPlain(2,j)) = m99(i,j)
forall(i=1_pInt:9_pInt,j=1_pInt:9_pInt) &
math_99to3333(mapPlain(1,i),mapPlain(2,i),mapPlain(1,j),mapPlain(2,j)) = m99(i,j)
end function math_Plain99to3333
end function math_99to3333
!--------------------------------------------------------------------------------------------------
!> @brief convert Mandel matrix 66 into Plain matrix 66
!> @brief convert symmetric 3333 matrix into 66 matrix
!> @details Weighted conversion (default) rearranges according to Nye and weights shear
! components according to Mandel. Advisable for matrix operations.
! Unweighted conversion only changes order according to Nye
!--------------------------------------------------------------------------------------------------
pure function math_Mandel66toPlain66(m66)
pure function math_sym3333to66(m3333,weighted)
implicit none
real(pReal), dimension(6,6), intent(in) :: m66
real(pReal), dimension(6,6) :: math_Mandel66toPlain66
integer(pInt) :: i,j
forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
math_Mandel66toPlain66(i,j) = invnrmMandel(i) * invnrmMandel(j) * m66(i,j)
end function math_Mandel66toPlain66
!--------------------------------------------------------------------------------------------------
!> @brief convert Plain matrix 66 into Mandel matrix 66
!--------------------------------------------------------------------------------------------------
pure function math_Plain66toMandel66(m66)
implicit none
real(pReal), dimension(6,6), intent(in) :: m66
real(pReal), dimension(6,6) :: math_Plain66toMandel66
integer(pInt) :: i,j
forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
math_Plain66toMandel66(i,j) = nrmMandel(i) * nrmMandel(j) * m66(i,j)
end function math_Plain66toMandel66
!--------------------------------------------------------------------------------------------------
!> @brief convert symmetric 3333 tensor into Mandel matrix 66
!--------------------------------------------------------------------------------------------------
pure function math_Mandel3333to66(m3333)
implicit none
real(pReal), dimension(6,6) :: math_sym3333to66
real(pReal), dimension(3,3,3,3), intent(in) :: m3333
real(pReal), dimension(6,6) :: math_Mandel3333to66
logical, optional, intent(in) :: weighted
real(pReal), dimension(6) :: w
integer(pInt) :: i,j
if(present(weighted)) then
w = merge(nrmMandel,1.0_pReal,weighted)
else
w = nrmMandel
endif
forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) math_Mandel3333to66(i,j) = &
nrmMandel(i)*nrmMandel(j)*m3333(mapMandel(1,i),mapMandel(2,i),mapMandel(1,j),mapMandel(2,j))
forall(i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
math_sym3333to66(i,j) = w(i)*w(j)*m3333(mapNye(1,i),mapNye(2,i),mapNye(1,j),mapNye(2,j))
end function math_Mandel3333to66
end function math_sym3333to66
!--------------------------------------------------------------------------------------------------
!> @brief convert Mandel matrix 66 back to symmetric 3333 tensor
!> @brief convert 66 matrix into symmetric 3333 matrix
!> @details Weighted conversion (default) rearranges according to Nye and weights shear
! components according to Mandel. Advisable for matrix operations.
! Unweighted conversion only changes order according to Nye
!--------------------------------------------------------------------------------------------------
pure function math_Mandel66to3333(m66)
pure function math_66toSym3333(m66,weighted)
implicit none
real(pReal), dimension(3,3,3,3) :: math_Mandel66to3333
real(pReal), dimension(6,6), intent(in) :: m66
real(pReal), dimension(3,3,3,3) :: math_66toSym3333
real(pReal), dimension(6,6), intent(in) :: m66
logical, optional, intent(in) :: weighted
real(pReal), dimension(6) :: w
integer(pInt) :: i,j
if(present(weighted)) then
w = merge(invnrmMandel,1.0_pReal,weighted)
else
w = invnrmMandel
endif
forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt)
math_Mandel66to3333(mapMandel(1,i),mapMandel(2,i),mapMandel(1,j),mapMandel(2,j)) = &
invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
math_Mandel66to3333(mapMandel(2,i),mapMandel(1,i),mapMandel(1,j),mapMandel(2,j)) = &
invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
math_Mandel66to3333(mapMandel(1,i),mapMandel(2,i),mapMandel(2,j),mapMandel(1,j)) = &
invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
math_Mandel66to3333(mapMandel(2,i),mapMandel(1,i),mapMandel(2,j),mapMandel(1,j)) = &
invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
end forall
do i=1_pInt,6_pInt; do j=1_pInt, 6_pInt
math_66toSym3333(mapNye(1,i),mapNye(2,i),mapNye(1,j),mapNye(2,j)) = w(i)*w(j)*m66(i,j)
math_66toSym3333(mapNye(2,i),mapNye(1,i),mapNye(1,j),mapNye(2,j)) = w(i)*w(j)*m66(i,j)
math_66toSym3333(mapNye(1,i),mapNye(2,i),mapNye(2,j),mapNye(1,j)) = w(i)*w(j)*m66(i,j)
math_66toSym3333(mapNye(2,i),mapNye(1,i),mapNye(2,j),mapNye(1,j)) = w(i)*w(j)*m66(i,j)
enddo; enddo
end function math_Mandel66to3333
end function math_66toSym3333
!--------------------------------------------------------------------------------------------------
!> @brief convert Voigt matrix 66 back to symmetric 3333 tensor
!> @brief convert 66 Voigt matrix into symmetric 3333 matrix
!--------------------------------------------------------------------------------------------------
pure function math_Voigt66to3333(m66)
@ -1208,16 +1303,12 @@ pure function math_Voigt66to3333(m66)
real(pReal), dimension(6,6), intent(in) :: m66
integer(pInt) :: i,j
forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt)
math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(1,j),mapVoigt(2,j)) = &
invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(1,j),mapVoigt(2,j)) = &
invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(2,j),mapVoigt(1,j)) = &
invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(2,j),mapVoigt(1,j)) = &
invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
end forall
do i=1_pInt,6_pInt; do j=1_pInt, 6_pInt
math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(1,j),mapVoigt(2,j)) = m66(i,j)
math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(1,j),mapVoigt(2,j)) = m66(i,j)
math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(2,j),mapVoigt(1,j)) = m66(i,j)
math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(2,j),mapVoigt(1,j)) = m66(i,j)
enddo; enddo
end function math_Voigt66to3333
@ -1625,8 +1716,7 @@ pure function math_qToR(q)
real(pReal), dimension(3,3) :: math_qToR, T,S
integer(pInt) :: i, j
forall (i = 1_pInt:3_pInt, j = 1_pInt:3_pInt) &
T(i,j) = q(i+1_pInt) * q(j+1_pInt)
forall(i = 1_pInt:3_pInt, j = 1_pInt:3_pInt) T(i,j) = q(i+1_pInt) * q(j+1_pInt)
S = reshape( [0.0_pReal, -q(4), q(3), &
q(4), 0.0_pReal, -q(2), &
@ -1926,6 +2016,7 @@ end function math_symmetricEulers
!--------------------------------------------------------------------------------------------------
!> @brief eigenvalues and eigenvectors of symmetric matrix m
! ToDo: has wrong oder of arguments
!--------------------------------------------------------------------------------------------------
subroutine math_eigenValuesVectorsSym(m,values,vectors,error)
@ -1949,9 +2040,10 @@ end subroutine math_eigenValuesVectorsSym
!--------------------------------------------------------------------------------------------------
!> @brief eigenvalues and eigenvectors of symmetric 33 matrix m using an analytical expression
!> and the general LAPACK powered version for arbritrary sized matrices as fallback
!> @author Joachim Kopp, Max–Planck–Institut für Kernphysik, Heidelberg (Copyright (C) 2006)
!> @author Joachim Kopp, Max-Planck-Institut für Kernphysik, Heidelberg (Copyright (C) 2006)
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @details See http://arxiv.org/abs/physics/0610206 (DSYEVH3)
! ToDo: has wrong oder of arguments
!--------------------------------------------------------------------------------------------------
subroutine math_eigenValuesVectorsSym33(m,values,vectors)
@ -2031,7 +2123,7 @@ end function math_eigenvectorBasisSym
!--------------------------------------------------------------------------------------------------
!> @brief eigenvector basis of symmetric 33 matrix m
!--------------------------------------------------------------------------------------------------
function math_eigenvectorBasisSym33(m)
pure function math_eigenvectorBasisSym33(m)
implicit none
real(pReal), dimension(3,3) :: math_eigenvectorBasisSym33
@ -2096,7 +2188,7 @@ end function math_eigenvectorBasisSym33
!--------------------------------------------------------------------------------------------------
!> @brief logarithm eigenvector basis of symmetric 33 matrix m
!--------------------------------------------------------------------------------------------------
function math_eigenvectorBasisSym33_log(m)
pure function math_eigenvectorBasisSym33_log(m)
implicit none
real(pReal), dimension(3,3) :: math_eigenvectorBasisSym33_log
@ -2152,11 +2244,12 @@ function math_eigenvectorBasisSym33_log(m)
endif threeSimilarEigenvalues
math_eigenvectorBasisSym33_log = log(sqrt(values(1))) * EB(1:3,1:3,1) &
+ log(sqrt(values(2))) * EB(1:3,1:3,2) &
+ log(sqrt(values(3))) * EB(1:3,1:3,3)
+ log(sqrt(values(2))) * EB(1:3,1:3,2) &
+ log(sqrt(values(3))) * EB(1:3,1:3,3)
end function math_eigenvectorBasisSym33_log
!--------------------------------------------------------------------------------------------------
!> @brief rotational part from polar decomposition of 33 tensor m
!--------------------------------------------------------------------------------------------------
@ -2601,13 +2694,12 @@ pure function math_rotate_forward3333(tensor,rot_tensor)
real(pReal), dimension(3,3,3,3), intent(in) :: tensor
integer(pInt) :: i,j,k,l,m,n,o,p
math_rotate_forward3333= 0.0_pReal
do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt; do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt
do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt; do p = 1_pInt,3_pInt
math_rotate_forward3333(i,j,k,l) = math_rotate_forward3333(i,j,k,l) &
+ rot_tensor(i,m) * rot_tensor(j,n) &
* rot_tensor(k,o) * rot_tensor(l,p) * tensor(m,n,o,p)
math_rotate_forward3333 = 0.0_pReal
do i = 1_pInt,3_pInt;do j = 1_pInt,3_pInt;do k = 1_pInt,3_pInt;do l = 1_pInt,3_pInt
do m = 1_pInt,3_pInt;do n = 1_pInt,3_pInt;do o = 1_pInt,3_pInt;do p = 1_pInt,3_pInt
math_rotate_forward3333(i,j,k,l) &
= math_rotate_forward3333(i,j,k,l) &
+ rot_tensor(i,m) * rot_tensor(j,n) * rot_tensor(k,o) * rot_tensor(l,p) * tensor(m,n,o,p)
enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo
end function math_rotate_forward3333
@ -2633,4 +2725,19 @@ real(pReal) pure elemental function math_clip(a, left, right)
end function math_clip
#if defined(__PGI)
!--------------------------------------------------------------------------------------------------
!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10
!--------------------------------------------------------------------------------------------------
real(pReal) pure function norm2(v)
implicit none
real(pReal), intent(in), dimension(3) :: v
norm2 = sqrt(sum(v**2))
end function norm2
#endif
end module math

5
src/numerics.f90
View File

@ -276,8 +276,6 @@ subroutine numerics_init
numerics_integrator = IO_intValue(line,chunkPos,2_pInt)
case ('usepingpong')
usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('timesyncing')
numerics_timeSyncing = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('unitlength')
numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt)
@ -454,8 +452,6 @@ subroutine numerics_init
end select
#endif
numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator
!--------------------------------------------------------------------------------------------------
! writing parameters to output
write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain
@ -476,7 +472,6 @@ subroutine numerics_init
write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress
write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress
write(6,'(a24,2(1x,i8))') ' integrator: ',numerics_integrator
write(6,'(a24,1x,L8)') ' timeSyncing: ',numerics_timeSyncing
write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong
write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength

782
src/plastic_disloUCLA.f90
View File

File diff suppressed because it is too large Load Diff

1602
src/plastic_dislotwin.f90
View File

File diff suppressed because it is too large Load Diff

633
src/plastic_isotropic.f90
View File

@ -1,66 +1,69 @@
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for isotropic (ISOTROPIC) plasticity
!> @details Isotropic (ISOTROPIC) Plasticity which resembles the phenopowerlaw plasticity without
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for isotropic plasticity
!> @details Isotropic Plasticity which resembles the phenopowerlaw plasticity without
!! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an
!! untextured polycrystal
!--------------------------------------------------------------------------------------------------
module plastic_isotropic
use prec, only: &
pReal,&
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_isotropic_sizePostResult !< size of each post result output
plastic_isotropic_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
plastic_isotropic_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
plastic_isotropic_Noutput !< number of outputs per instance
enum, bind(c)
enumerator :: undefined_ID, &
flowstress_ID, &
strainrate_ID
plastic_isotropic_output !< name of each post result output
enum, bind(c)
enumerator :: &
undefined_ID, &
flowstress_ID, &
strainrate_ID
end enum
type, private :: tParameters !< container type for internal constitutive parameters
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
real(pReal) :: &
fTaylor, &
tau0, &
gdot0, &
n, &
type, private :: tParameters
real(pReal) :: &
fTaylor, & !< Taylor factor
tau0, & !< initial critical stress
gdot0, & !< reference strain rate
n, & !< stress exponent
h0, &
h0_slopeLnRate, &
tausat, &
tausat, & !< maximum critical stress
a, &
aTolFlowstress, &
aTolShear, &
tausat_SinhFitA, &
tausat_SinhFitB, &
tausat_SinhFitC, &
tausat_SinhFitD
logical :: &
tausat_SinhFitD, &
aTolFlowstress, &
aTolShear
integer(pInt) :: &
of_debug = 0_pInt
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
logical :: &
dilatation
end type
end type tParameters
type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance)
type, private :: tIsotropicState !< internal state aliases
real(pReal), pointer, dimension(:) :: & ! scalars along NipcMyInstance
type, private :: tIsotropicState
real(pReal), pointer, dimension(:) :: &
flowstress, &
accumulatedShear
end type
end type tIsotropicState
type(tIsotropicState), allocatable, dimension(:), private :: & !< state aliases per instance
state, &
dotState
!--------------------------------------------------------------------------------------------------
! containers for parameters and state
type(tParameters), allocatable, dimension(:), private :: param
type(tIsotropicState), allocatable, dimension(:), private :: &
dotState, &
state
public :: &
public :: &
plastic_isotropic_init, &
plastic_isotropic_LpAndItsTangent, &
plastic_isotropic_LiAndItsTangent, &
@ -69,7 +72,6 @@ module plastic_isotropic
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
@ -80,20 +82,29 @@ subroutine plastic_isotropic_init()
compiler_version, &
compiler_options
#endif
use IO
use prec, only: &
pStringLen
use debug, only: &
#ifdef DEBUG
debug_e, &
debug_i, &
debug_g, &
debug_levelExtensive, &
#endif
debug_level, &
debug_constitutive, &
debug_levelBasic
use numerics, only: &
numerics_integrator
use math, only: &
math_Mandel3333to66, &
math_Voigt66to3333
use IO, only: &
IO_error, &
IO_timeStamp
use material, only: &
#ifdef DEBUG
phasememberAt, &
#endif
phase_plasticity, &
phase_plasticityInstance, &
phase_Noutput, &
material_allocatePlasticState, &
PLASTICITY_ISOTROPIC_label, &
PLASTICITY_ISOTROPIC_ID, &
material_phase, &
@ -101,148 +112,142 @@ use IO
use config, only: &
MATERIAL_partPhase, &
config_phase
use lattice
use lattice
implicit none
type(tParameters), pointer :: prm
integer(pInt) :: &
phase, &
instance, &
maxNinstance, &
sizeDotState, &
sizeState, &
sizeDeltaState
character(len=65536) :: &
extmsg = ''
integer(pInt) :: NipcMyPhase,i
character(len=65536), dimension(:), allocatable :: outputs
Ninstance, &
p, i, &
NipcMyPhase, &
sizeState, sizeDotState
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>'
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
character(len=pStringLen) :: &
extmsg = ''
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_label//' init -+>>>'
write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia, 145:37-40, 2018'
write(6,'(/,a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
Ninstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
! public variables
allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt)
allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance))
allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(plastic_isotropic_output(maxval(phase_Noutput),Ninstance))
plastic_isotropic_output = ''
allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt)
allocate(param(maxNinstance)) ! one container of parameters per instance
allocate(state(maxNinstance)) ! internal state aliases
allocate(dotState(maxNinstance))
allocate(param(Ninstance))
allocate(state(Ninstance))
allocate(dotState(Ninstance))
do phase = 1_pInt, size(phase_plasticityInstance)
if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then
instance = phase_plasticityInstance(phase)
prm => param(instance) ! shorthand pointer to parameter object of my constitutive law
prm%tau0 = config_phase(phase)%getFloat('tau0')
prm%tausat = config_phase(phase)%getFloat('tausat')
prm%gdot0 = config_phase(phase)%getFloat('gdot0')
prm%n = config_phase(phase)%getFloat('n')
prm%h0 = config_phase(phase)%getFloat('h0')
prm%fTaylor = config_phase(phase)%getFloat('m')
prm%h0_slopeLnRate = config_phase(phase)%getFloat('h0_slopelnrate', defaultVal=0.0_pReal)
prm%tausat_SinhFitA = config_phase(phase)%getFloat('tausat_sinhfita',defaultVal=0.0_pReal)
prm%tausat_SinhFitB = config_phase(phase)%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal)
prm%tausat_SinhFitC = config_phase(phase)%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal)
prm%tausat_SinhFitD = config_phase(phase)%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal)
prm%a = config_phase(phase)%getFloat('a')
prm%aTolFlowStress = config_phase(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal)
prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal)
prm%dilatation = config_phase(phase)%keyExists('/dilatation/')
do p = 1_pInt, size(phase_plasticity)
if (phase_plasticity(p) /= PLASTICITY_ISOTROPIC_ID) cycle
associate(prm => param(phase_plasticityInstance(p)), &
dot => dotState(phase_plasticityInstance(p)), &
stt => state(phase_plasticityInstance(p)), &
config => config_phase(p))
#if defined(__GFORTRAN__)
outputs = ['GfortranBug86277']
outputs = config_phase(phase)%getStrings('(output)',defaultVal=outputs)
if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::]
#else
outputs = config_phase(phase)%getStrings('(output)',defaultVal=[character(len=65536)::])
#ifdef DEBUG
if (p==material_phase(debug_g,debug_i,debug_e)) then
prm%of_debug = phasememberAt(debug_g,debug_i,debug_e)
endif
#endif
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
select case(outputs(i))
case ('flowstress')
plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i)
plasticState(phase)%sizePostResults = plasticState(phase)%sizePostResults + 1_pInt
plastic_isotropic_sizePostResult(i,instance) = 1_pInt
prm%outputID = [prm%outputID,flowstress_ID]
case ('strainrate')
plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i)
plasticState(phase)%sizePostResults = &
plasticState(phase)%sizePostResults + 1_pInt
plastic_isotropic_sizePostResult(i,instance) = 1_pInt
prm%outputID = [prm%outputID,strainrate_ID]
end select
enddo
prm%tau0 = config%getFloat('tau0')
prm%tausat = config%getFloat('tausat')
prm%gdot0 = config%getFloat('gdot0')
prm%n = config%getFloat('n')
prm%h0 = config%getFloat('h0')
prm%fTaylor = config%getFloat('m')
prm%h0_slopeLnRate = config%getFloat('h0_slopelnrate', defaultVal=0.0_pReal)
prm%tausat_SinhFitA = config%getFloat('tausat_sinhfita',defaultVal=0.0_pReal)
prm%tausat_SinhFitB = config%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal)
prm%tausat_SinhFitC = config%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal)
prm%tausat_SinhFitD = config%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal)
prm%a = config%getFloat('a')
prm%aTolFlowStress = config%getFloat('atol_flowstress',defaultVal=1.0_pReal)
prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal)
prm%dilatation = config%keyExists('/dilatation/')
!--------------------------------------------------------------------------------------------------
! sanity checks
extmsg = ''
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"'aTolShear' "
if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//"'tau0' "
if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//"'gdot0' "
if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//"'n' "
if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//"'tausat' "
if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//"'a' "
if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//"'m' "
if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' "
if (extmsg /= '') call IO_error(211_pInt,ip=instance,&
ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')')
extmsg = ''
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear'
if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//' tau0'
if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0'
if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n'
if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//' tausat'
if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//' a'
if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//' m'
if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_flowstress'
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' atol_shear'
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('flowstress')
outputID = flowstress_ID
case ('strainrate')
outputID = strainrate_ID
end select
if (outputID /= undefined_ID) then
plastic_isotropic_output(i,phase_plasticityInstance(p)) = outputs(i)
plastic_isotropic_sizePostResult(i,phase_plasticityInstance(p)) = 1_pInt
prm%outputID = [prm%outputID, outputID]
endif
enddo
!--------------------------------------------------------------------------------------------------
! allocate state arrays
NipcMyPhase = count(material_phase == phase) ! number of own material points (including point components ipc)
NipcMyPhase = count(material_phase == p)
sizeDotState = size(['flowstress ','accumulated_shear'])
sizeState = sizeDotState
sizeDotState = size(["flowstress ","accumulated_shear"])
sizeDeltaState = 0_pInt ! no sudden jumps in state
sizeState = sizeDotState + sizeDeltaState
plasticState(phase)%sizeState = sizeState
plasticState(phase)%sizeDotState = sizeDotState
plasticState(phase)%sizeDeltaState = sizeDeltaState
plasticState(phase)%nSlip = 1
allocate(plasticState(phase)%aTolState ( sizeState))
allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%state ( sizeState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase),source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase),source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase),source=0.0_pReal)
call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, &
1_pInt,0_pInt,0_pInt)
plasticState(p)%sizePostResults = sum(plastic_isotropic_sizePostResult(:,phase_plasticityInstance(p)))
!--------------------------------------------------------------------------------------------------
! locally defined state aliases and initialization of state0 and aTolState
stt%flowstress => plasticState(p)%state (1,:)
stt%flowstress = prm%tau0
dot%flowstress => plasticState(p)%dotState(1,:)
plasticState(p)%aTolState(1) = prm%aTolFlowstress
state(instance)%flowstress => plasticState(phase)%state (1,1:NipcMyPhase)
dotState(instance)%flowstress => plasticState(phase)%dotState (1,1:NipcMyPhase)
plasticState(phase)%state0(1,1:NipcMyPhase) = prm%tau0
plasticState(phase)%aTolState(1) = prm%aTolFlowstress
stt%accumulatedShear => plasticState(p)%state (2,:)
dot%accumulatedShear => plasticState(p)%dotState(2,:)
plasticState(p)%aTolState(2) = prm%aTolShear
! global alias
plasticState(p)%slipRate => plasticState(p)%dotState(2:2,:)
plasticState(p)%accumulatedSlip => plasticState(p)%state (2:2,:)
state(instance)%accumulatedShear => plasticState(phase)%state (2,1:NipcMyPhase)
dotState(instance)%accumulatedShear => plasticState(phase)%dotState (2,1:NipcMyPhase)
plasticState(phase)%state0 (2,1:NipcMyPhase) = 0.0_pReal
plasticState(phase)%aTolState(2) = prm%aTolShear
! global alias
plasticState(phase)%slipRate => plasticState(phase)%dotState(2:2,1:NipcMyPhase)
plasticState(phase)%accumulatedSlip => plasticState(phase)%state (2:2,1:NipcMyPhase)
plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally
end associate
endif
enddo
end subroutine plastic_isotropic_init
@ -251,309 +256,237 @@ end subroutine plastic_isotropic_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el)
subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic, &
debug_constitutive,&
debug_levelExtensive, &
debug_levelSelective, &
debug_e, &
debug_i, &
debug_g
debug_levelSelective
#endif
use math, only: &
math_mul6x6, &
math_Mandel6to33, &
math_Plain3333to99, &
math_deviatoric33, &
math_mul33xx33
use material, only: &
phasememberAt, &
material_phase, &
phase_plasticityInstance
implicit none
real(pReal), dimension(3,3), intent(out) :: &
real(pReal), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
real(pReal), dimension(9,9), intent(out) :: &
dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress
real(pReal), dimension(3,3,3,3), intent(out) :: &
dLp_dMp !< derivative of Lp with respect to the Mandel stress
real(pReal), dimension(6), intent(in) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
instance, &
of
type(tParameters), pointer :: prm
real(pReal), dimension(3,3) :: &
Tstar_dev_33 !< deviatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor
real(pReal), dimension(3,3,3,3) :: &
dLp_dTstar_3333 !< derivative of Lp with respect to Tstar as 4th order tensor
Mp_dev !< deviatoric part of the Mandel stress
real(pReal) :: &
gamma_dot, & !< strainrate
norm_Tstar_dev, & !< euclidean norm of Tstar_dev
squarenorm_Tstar_dev !< square of the euclidean norm of Tstar_dev
norm_Mp_dev, & !< norm of the deviatoric part of the Mandel stress
squarenorm_Mp_dev !< square of the norm of the deviatoric part of the Mandel stress
integer(pInt) :: &
instance, of, &
k, l, m, n
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
Tstar_dev_33 = math_deviatoric33(math_Mandel6to33(Tstar_v)) ! deviatoric part of 2nd Piola-Kirchhoff stress
squarenorm_Tstar_dev = math_mul33xx33(Tstar_dev_33,Tstar_dev_33)
norm_Tstar_dev = sqrt(squarenorm_Tstar_dev)
associate(prm => param(instance), stt => state(instance))
if (norm_Tstar_dev <= 0.0_pReal) then ! Tstar == 0 --> both Lp and dLp_dTstar are zero
Lp = 0.0_pReal
dLp_dTstar99 = 0.0_pReal
else
gamma_dot = prm%gdot0 &
* ( sqrt(1.5_pReal) * norm_Tstar_dev / prm%fTaylor / state(instance)%flowstress(of) ) &
**prm%n
Mp_dev = math_deviatoric33(Mp)
squarenorm_Mp_dev = math_mul33xx33(Mp_dev,Mp_dev)
norm_Mp_dev = sqrt(squarenorm_Mp_dev)
Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/prm%fTaylor
if (norm_Mp_dev > 0.0_pReal) then
gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%fTaylor*stt%flowstress(of))) **prm%n
Lp = Mp_dev/norm_Mp_dev * gamma_dot/prm%fTaylor
#ifdef DEBUG
if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CONST isotropic >> at el ip g ',el,ip,ipc
.and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', &
transpose(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Tstar_dev*1.0e-6_pReal
transpose(Mp_dev)*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', gamma_dot
end if
!--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Lp
#endif
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * &
Tstar_dev_33(k,l)*Tstar_dev_33(m,n) / squarenorm_Tstar_dev
dLp_dMp(k,l,m,n) = (prm%n-1.0_pReal) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) &
dLp_dTstar_3333(k,l,k,l) = dLp_dTstar_3333(k,l,k,l) + 1.0_pReal
dLp_dMp(k,l,k,l) = dLp_dMp(k,l,k,l) + 1.0_pReal
forall (k=1_pInt:3_pInt,m=1_pInt:3_pInt) &
dLp_dTstar_3333(k,k,m,m) = dLp_dTstar_3333(k,k,m,m) - 1.0_pReal/3.0_pReal
dLp_dTstar99 = math_Plain3333to99(gamma_dot / prm%fTaylor * &
dLp_dTstar_3333 / norm_Tstar_dev)
dLp_dMp(k,k,m,m) = dLp_dMp(k,k,m,m) - 1.0_pReal/3.0_pReal
dLp_dMp = gamma_dot / prm%fTaylor * dLp_dMp / norm_Mp_dev
else
Lp = 0.0_pReal
dLp_dMp = 0.0_pReal
end if
end associate
end subroutine plastic_isotropic_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
! ToDo: Rename Tstar to Mi?
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar_3333,Tstar_v,ipc,ip,el)
subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
use math, only: &
math_mul6x6, &
math_Mandel6to33, &
math_Plain3333to99, &
math_spherical33, &
math_mul33xx33
use material, only: &
phasememberAt, &
material_phase, &
phase_plasticityInstance
implicit none
real(pReal), dimension(3,3), intent(out) :: &
Li !< plastic velocity gradient
Li !< inleastic velocity gradient
real(pReal), dimension(3,3,3,3), intent(out) :: &
dLi_dTstar_3333 !< derivative of Li with respect to Tstar as 4th order tensor
real(pReal), dimension(6), intent(in) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
dLi_dTstar !< derivative of Li with respect to the Mandel stress
real(pReal), dimension(3,3), intent(in) :: &
Tstar !< Mandel stress ToDo: Mi?
integer(pInt), intent(in) :: &
instance, &
of
type(tParameters), pointer :: prm
real(pReal), dimension(3,3) :: &
Tstar_sph_33 !< sphiatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor
Tstar_sph !< sphiatoric part of the Mandel stress
real(pReal) :: &
gamma_dot, & !< strainrate
norm_Tstar_sph, & !< euclidean norm of Tstar_sph
squarenorm_Tstar_sph !< square of the euclidean norm of Tstar_sph
integer(pInt) :: &
instance, of, &
k, l, m, n
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
Tstar_sph_33 = math_spherical33(math_Mandel6to33(Tstar_v)) ! spherical part of 2nd Piola-Kirchhoff stress
squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph_33,Tstar_sph_33)
norm_Tstar_sph = sqrt(squarenorm_Tstar_sph)
associate(prm => param(instance), stt => state(instance))
if (prm%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! Tstar == 0 or J2 plascitiy --> both Li and dLi_dTstar are zero
gamma_dot = prm%gdot0 &
* (sqrt(1.5_pReal) * norm_Tstar_sph / prm%fTaylor / state(instance)%flowstress(of) ) &
**prm%n
Tstar_sph = math_spherical33(Tstar)
squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph,Tstar_sph)
norm_Tstar_sph = sqrt(squarenorm_Tstar_sph)
Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/prm%fTaylor
if (prm%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! no stress or J2 plastitiy --> Li and its derivative are zero
gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Tstar_sph /(prm%fTaylor*stt%flowstress(of))) **prm%n
!--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Li
Li = Tstar_sph/norm_Tstar_sph * gamma_dot/prm%fTaylor
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLi_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * &
Tstar_sph_33(k,l)*Tstar_sph_33(m,n) / squarenorm_Tstar_sph
dLi_dTstar(k,l,m,n) = (prm%n-1.0_pReal) * Tstar_sph(k,l)*Tstar_sph(m,n) / squarenorm_Tstar_sph
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) &
dLi_dTstar_3333(k,l,k,l) = dLi_dTstar_3333(k,l,k,l) + 1.0_pReal
dLi_dTstar(k,l,k,l) = dLi_dTstar(k,l,k,l) + 1.0_pReal
dLi_dTstar_3333 = gamma_dot / prm%fTaylor * &
dLi_dTstar_3333 / norm_Tstar_sph
dLi_dTstar = gamma_dot / prm%fTaylor * dLi_dTstar / norm_Tstar_sph
else
Li = 0.0_pReal
dLi_dTstar_3333 = 0.0_pReal
Li = 0.0_pReal
dLi_dTstar = 0.0_pReal
endif
end associate
end subroutine plastic_isotropic_LiAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief calculates the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el)
subroutine plastic_isotropic_dotState(Mp,instance,of)
use prec, only: &
dEq0
use math, only: &
math_mul6x6
use material, only: &
phasememberAt, &
material_phase, &
phase_plasticityInstance
math_mul33xx33, &
math_deviatoric33
implicit none
real(pReal), dimension(6), intent(in):: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
type(tParameters), pointer :: prm
real(pReal), dimension(6) :: &
Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
instance, &
of
real(pReal) :: &
gamma_dot, & !< strainrate
hardening, & !< hardening coefficient
saturation, & !< saturation flowstress
norm_Tstar_v !< euclidean norm of Tstar_dev
integer(pInt) :: &
instance, & !< instance of my instance (unique number of my constitutive model)
of !< shortcut notation for offset position in state array
norm_Mp !< norm of the (deviatoric) Mandel stress
associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
!--------------------------------------------------------------------------------------------------
! norm of (deviatoric) 2nd Piola-Kirchhoff stress
if (prm%dilatation) then
norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v))
norm_Mp = sqrt(math_mul33xx33(Mp,Mp))
else
Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal
Tstar_dev_v(4:6) = Tstar_v(4:6)
norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v))
end if
!--------------------------------------------------------------------------------------------------
! strain rate
gamma_dot = prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v &
/ &!-----------------------------------------------------------------------------------
(prm%fTaylor*state(instance)%flowstress(of) ))**prm%n
!--------------------------------------------------------------------------------------------------
! hardening coefficient
norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp)))
endif
gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp /(prm%fTaylor*stt%flowstress(of))) **prm%n
if (abs(gamma_dot) > 1e-12_pReal) then
if (dEq0(prm%tausat_SinhFitA)) then
saturation = prm%tausat
else
saturation = prm%tausat &
+ asinh( (gamma_dot / prm%tausat_SinhFitA&
)**(1.0_pReal / prm%tausat_SinhFitD)&
+ asinh( (gamma_dot / prm%tausat_SinhFitA)**(1.0_pReal / prm%tausat_SinhFitD) &
)**(1.0_pReal / prm%tausat_SinhFitC) &
/ ( prm%tausat_SinhFitB &
* (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n) &
)
/ prm%tausat_SinhFitB * (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n)
endif
hardening = ( prm%h0 + prm%h0_slopeLnRate * log(gamma_dot) ) &
* abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**prm%a &
* sign(1.0_pReal, 1.0_pReal - state(instance)%flowstress(of)/saturation)
* abs( 1.0_pReal - stt%flowstress(of)/saturation )**prm%a &
* sign(1.0_pReal, 1.0_pReal - stt%flowstress(of)/saturation)
else
hardening = 0.0_pReal
endif
dotState(instance)%flowstress (of) = hardening * gamma_dot
dotState(instance)%accumulatedShear(of) = gamma_dot
dot%flowstress (of) = hardening * gamma_dot
dot%accumulatedShear(of) = gamma_dot
end associate
end subroutine plastic_isotropic_dotState
!--------------------------------------------------------------------------------------------------
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_isotropic_postResults(Tstar_v,ipc,ip,el)
function plastic_isotropic_postResults(Mp,instance,of) result(postResults)
use math, only: &
math_mul6x6
use material, only: &
plasticState, &
material_phase, &
phasememberAt, &
phase_plasticityInstance
math_mul33xx33, &
math_deviatoric33
implicit none
real(pReal), dimension(6), intent(in) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
instance, &
of
type(tParameters), pointer :: prm
real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: &
plastic_isotropic_postResults
real(pReal), dimension(sum(plastic_isotropic_sizePostResult(:,instance))) :: &
postResults
real(pReal), dimension(6) :: &
Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation
real(pReal) :: &
norm_Tstar_v ! euclidean norm of Tstar_dev
norm_Mp !< norm of the Mandel stress
integer(pInt) :: &
instance, & !< instance of my instance (unique number of my constitutive model)
of, & !< shortcut notation for offset position in state array
c, &
o
o,c
associate(prm => param(instance), stt => state(instance))
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
!--------------------------------------------------------------------------------------------------
! norm of (deviatoric) 2nd Piola-Kirchhoff stress
if (prm%dilatation) then
norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v))
norm_Mp = sqrt(math_mul33xx33(Mp,Mp))
else
Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal
Tstar_dev_v(4:6) = Tstar_v(4:6)
norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v))
end if
c = 0_pInt
plastic_isotropic_postResults = 0.0_pReal
norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp)))
endif
outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance)
c = 0_pInt
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
case (flowstress_ID)
plastic_isotropic_postResults(c+1_pInt) = state(instance)%flowstress(of)
postResults(c+1_pInt) = stt%flowstress(of)
c = c + 1_pInt
case (strainrate_ID)
plastic_isotropic_postResults(c+1_pInt) = &
prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v &
/ &!----------------------------------------------------------------------------------
(prm%fTaylor * state(instance)%flowstress(of)) ) ** prm%n
postResults(c+1_pInt) = prm%gdot0 &
* (sqrt(1.5_pReal) * norm_Mp /(prm%fTaylor * stt%flowstress(of)))**prm%n
c = c + 1_pInt
end select
enddo outputsLoop
end associate
end function plastic_isotropic_postResults

1273
src/plastic_kinematichardening.f90
View File

File diff suppressed because it is too large Load Diff

57
src/plastic_none.f90
View File

@ -1,7 +1,8 @@
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for purely elastic material
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Dummy plasticity for purely elastic material
!--------------------------------------------------------------------------------------------------
module plastic_none
@ -13,7 +14,6 @@ module plastic_none
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
@ -32,52 +32,39 @@ subroutine plastic_none_init
debug_levelBasic
use IO, only: &
IO_timeStamp
use numerics, only: &
numerics_integrator
use material, only: &
phase_plasticity, &
material_allocatePlasticState, &
PLASTICITY_NONE_label, &
PLASTICITY_NONE_ID, &
material_phase, &
plasticState, &
PLASTICITY_none_ID
plasticState
implicit none
integer(pInt) :: &
maxNinstance, &
phase, &
NofMyPhase
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>'
Ninstance, &
p, &
NipcMyPhase
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt)
Ninstance = int(count(phase_plasticity == PLASTICITY_NONE_ID),pInt)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
initializeInstances: do phase = 1_pInt, size(phase_plasticity)
if (phase_plasticity(phase) == PLASTICITY_none_ID) then
NofMyPhase=count(material_phase==phase)
do p = 1_pInt, size(phase_plasticity)
if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle
allocate(plasticState(phase)%aTolState (0_pInt))
allocate(plasticState(phase)%state0 (0_pInt,NofMyPhase))
allocate(plasticState(phase)%partionedState0 (0_pInt,NofMyPhase))
allocate(plasticState(phase)%subState0 (0_pInt,NofMyPhase))
allocate(plasticState(phase)%state (0_pInt,NofMyPhase))
!--------------------------------------------------------------------------------------------------
! allocate state arrays
NipcMyPhase = count(material_phase == p)
call material_allocatePlasticState(p,NipcMyPhase,0_pInt,0_pInt,0_pInt, &
0_pInt,0_pInt,0_pInt)
plasticState(p)%sizePostResults = 0_pInt
allocate(plasticState(phase)%dotState (0_pInt,NofMyPhase))
allocate(plasticState(phase)%deltaState (0_pInt,NofMyPhase))
if (any(numerics_integrator == 1_pInt)) then
allocate(plasticState(phase)%previousDotState (0_pInt,NofMyPhase))
allocate(plasticState(phase)%previousDotState2(0_pInt,NofMyPhase))
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(plasticState(phase)%RK4dotState (0_pInt,NofMyPhase))
if (any(numerics_integrator == 5_pInt)) &
allocate(plasticState(phase)%RKCK45dotState (6,0_pInt,NofMyPhase))
endif
enddo initializeInstances
enddo
end subroutine plastic_none_init

619
src/plastic_nonlocal.f90
View File

@ -150,61 +150,34 @@ module plastic_nonlocal
enum, bind(c)
enumerator :: undefined_ID, &
rho_ID, &
delta_ID, &
rho_edge_ID, &
rho_screw_ID, &
rho_sgl_ID, &
delta_sgl_ID, &
rho_sgl_edge_ID, &
rho_sgl_edge_pos_ID, &
rho_sgl_edge_neg_ID, &
rho_sgl_screw_ID, &
rho_sgl_screw_pos_ID, &
rho_sgl_screw_neg_ID, &
rho_sgl_mobile_ID, &
rho_sgl_edge_mobile_ID, &
rho_sgl_edge_pos_mobile_ID, &
rho_sgl_edge_neg_mobile_ID, &
rho_sgl_screw_mobile_ID, &
rho_sgl_screw_pos_mobile_ID, &
rho_sgl_screw_neg_mobile_ID, &
rho_sgl_immobile_ID, &
rho_sgl_edge_immobile_ID, &
rho_sgl_edge_pos_immobile_ID, &
rho_sgl_edge_neg_immobile_ID, &
rho_sgl_screw_immobile_ID, &
rho_sgl_screw_pos_immobile_ID, &
rho_sgl_screw_neg_immobile_ID, &
rho_dip_ID, &
delta_dip_ID, &
rho_dip_edge_ID, &
rho_dip_screw_ID, &
excess_rho_ID, &
excess_rho_edge_ID, &
excess_rho_screw_ID, &
rho_forest_ID, &
shearrate_ID, &
resolvedstress_ID, &
resolvedstress_external_ID, &
resolvedstress_back_ID, &
resistance_ID, &
rho_dot_ID, &
rho_dot_sgl_ID, &
rho_dot_sgl_mobile_ID, &
rho_dot_dip_ID, &
rho_dot_gen_ID, &
rho_dot_gen_edge_ID, &
rho_dot_gen_screw_ID, &
rho_dot_sgl2dip_ID, &
rho_dot_sgl2dip_edge_ID, &
rho_dot_sgl2dip_screw_ID, &
rho_dot_ann_ath_ID, &
rho_dot_ann_the_ID, &
rho_dot_ann_the_edge_ID, &
rho_dot_ann_the_screw_ID, &
rho_dot_edgejogs_ID, &
rho_dot_flux_ID, &
rho_dot_flux_mobile_ID, &
rho_dot_flux_edge_ID, &
rho_dot_flux_screw_ID, &
@ -212,28 +185,9 @@ module plastic_nonlocal
velocity_edge_neg_ID, &
velocity_screw_pos_ID, &
velocity_screw_neg_ID, &
slipdirectionx_ID, &
slipdirectiony_ID, &
slipdirectionz_ID, &
slipnormalx_ID, &
slipnormaly_ID, &
slipnormalz_ID, &
fluxdensity_edge_posx_ID, &
fluxdensity_edge_posy_ID, &
fluxdensity_edge_posz_ID, &
fluxdensity_edge_negx_ID, &
fluxdensity_edge_negy_ID, &
fluxdensity_edge_negz_ID, &
fluxdensity_screw_posx_ID, &
fluxdensity_screw_posy_ID, &
fluxdensity_screw_posz_ID, &
fluxdensity_screw_negx_ID, &
fluxdensity_screw_negy_ID, &
fluxdensity_screw_negz_ID, &
maximumdipoleheight_edge_ID, &
maximumdipoleheight_screw_ID, &
accumulatedshear_ID, &
dislocationstress_ID
accumulatedshear_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
plastic_nonlocal_outputID !< ID of each post result output
@ -262,8 +216,7 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use math, only: math_Mandel3333to66, &
math_Voigt66to3333, &
use math, only: math_Voigt66to3333, &
math_mul3x3, &
math_transpose33
use IO, only: IO_read, &
@ -291,11 +244,11 @@ use material, only: phase_plasticity, &
PLASTICITY_NONLOCAL_label, &
PLASTICITY_NONLOCAL_ID, &
plasticState, &
material_phase
material_phase, &
material_allocatePlasticState
use config, only: MATERIAL_partPhase
use lattice
use numerics,only: &
numerics_integrator
implicit none
@ -426,76 +379,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('rho')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('delta')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_edge')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_edge_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_screw')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_screw_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('delta_sgl')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_sgl_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_edge')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_edge_pos')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_edge_neg')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_screw')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_screw_pos')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_screw_neg')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_mobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_mobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_edge_mobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_mobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_edge_pos_mobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID
@ -506,11 +389,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_screw_mobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_mobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_screw_pos_mobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID
@ -521,16 +399,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_immobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_immobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_edge_immobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_immobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_edge_pos_immobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID
@ -541,11 +409,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_screw_immobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_immobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_sgl_screw_pos_immobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID
@ -556,16 +419,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dip')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('delta_dip')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_dip_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dip_edge')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_edge_ID
@ -576,21 +429,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_screw_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('excess_rho')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('excess_rho_edge')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_edge_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('excess_rho_screw')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_screw_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_forest')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_forest_ID
@ -621,11 +459,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resistance_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot_sgl')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_ID
@ -656,11 +489,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_screw_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot_sgl2dip')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot_sgl2dip_edge')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID
@ -676,11 +504,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_ath_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot_ann_the')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot_ann_the_edge')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_edge_ID
@ -696,11 +519,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_edgejogs_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot_flux')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('rho_dot_flux_mobile')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_mobile_ID
@ -736,96 +554,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_neg_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('slipdirection.x')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionx_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('slipdirection.y')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectiony_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('slipdirection.z')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionz_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('slipnormal.x')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalx_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('slipnormal.y')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormaly_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('slipnormal.z')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalz_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_edge_pos.x')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posx_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_edge_pos.y')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posy_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_edge_pos.z')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posz_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_edge_neg.x')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negx_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_edge_neg.y')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negy_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_edge_neg.z')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negz_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_screw_pos.x')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posx_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_screw_pos.y')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posy_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_screw_pos.z')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posz_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_screw_neg.x')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negx_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_screw_neg.y')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negy_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('fluxdensity_screw_neg.z')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negz_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('maximumdipoleheight_edge')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_edge_ID
@ -841,11 +569,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = accumulatedshear_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case ('dislocationstress')
plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = dislocationstress_ID
plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
case ('nslip')
if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) &
@ -1195,93 +918,8 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances),
outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
select case(plastic_nonlocal_outputID(o,instance))
case( rho_ID, &
delta_ID, &
rho_edge_ID, &
rho_screw_ID, &
rho_sgl_ID, &
delta_sgl_ID, &
rho_sgl_edge_ID, &
rho_sgl_edge_pos_ID, &
rho_sgl_edge_neg_ID, &
rho_sgl_screw_ID, &
rho_sgl_screw_pos_ID, &
rho_sgl_screw_neg_ID, &
rho_sgl_mobile_ID, &
rho_sgl_edge_mobile_ID, &
rho_sgl_edge_pos_mobile_ID, &
rho_sgl_edge_neg_mobile_ID, &
rho_sgl_screw_mobile_ID, &
rho_sgl_screw_pos_mobile_ID, &
rho_sgl_screw_neg_mobile_ID, &
rho_sgl_immobile_ID, &
rho_sgl_edge_immobile_ID, &
rho_sgl_edge_pos_immobile_ID, &
rho_sgl_edge_neg_immobile_ID, &
rho_sgl_screw_immobile_ID, &
rho_sgl_screw_pos_immobile_ID, &
rho_sgl_screw_neg_immobile_ID, &
rho_dip_ID, &
delta_dip_ID, &
rho_dip_edge_ID, &
rho_dip_screw_ID, &
excess_rho_ID, &
excess_rho_edge_ID, &
excess_rho_screw_ID, &
rho_forest_ID, &
shearrate_ID, &
resolvedstress_ID, &
resolvedstress_external_ID, &
resolvedstress_back_ID, &
resistance_ID, &
rho_dot_ID, &
rho_dot_sgl_ID, &
rho_dot_sgl_mobile_ID, &
rho_dot_dip_ID, &
rho_dot_gen_ID, &
rho_dot_gen_edge_ID, &
rho_dot_gen_screw_ID, &
rho_dot_sgl2dip_ID, &
rho_dot_sgl2dip_edge_ID, &
rho_dot_sgl2dip_screw_ID, &
rho_dot_ann_ath_ID, &
rho_dot_ann_the_ID, &
rho_dot_ann_the_edge_ID, &
rho_dot_ann_the_screw_ID, &
rho_dot_edgejogs_ID, &
rho_dot_flux_ID, &
rho_dot_flux_mobile_ID, &
rho_dot_flux_edge_ID, &
rho_dot_flux_screw_ID, &
velocity_edge_pos_ID, &
velocity_edge_neg_ID, &
velocity_screw_pos_ID, &
velocity_screw_neg_ID, &
slipdirectionx_ID, &
slipdirectiony_ID, &
slipdirectionz_ID, &
slipnormalx_ID, &
slipnormaly_ID, &
slipnormalz_ID, &
fluxdensity_edge_posx_ID, &
fluxdensity_edge_posy_ID, &
fluxdensity_edge_posz_ID, &
fluxdensity_edge_negx_ID, &
fluxdensity_edge_negy_ID, &
fluxdensity_edge_negz_ID, &
fluxdensity_screw_posx_ID, &
fluxdensity_screw_posy_ID, &
fluxdensity_screw_posz_ID, &
fluxdensity_screw_negx_ID, &
fluxdensity_screw_negy_ID, &
fluxdensity_screw_negz_ID, &
maximumdipoleheight_edge_ID, &
maximumdipoleheight_screw_ID, &
accumulatedshear_ID )
mySize = totalNslip(instance)
case(dislocationstress_ID)
mySize = 6_pInt
case default
mySize = totalNslip(instance)
end select
if (mySize > 0_pInt) then ! any meaningful output found
@ -1290,30 +928,14 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances),
endif
enddo outputsLoop
plasticState(phase)%sizeState = sizeState
plasticState(phase)%sizeDotState = sizeDotState
plasticState(phase)%sizeDeltaState = sizeDeltaState
plasticState(phase)%sizePostResults = plastic_nonlocal_sizePostResults(instance)
plasticState(phase)%nonlocal = .true.
plasticState(phase)%nSlip = totalNslip(instance)
plasticState(phase)%nTwin = 0_pInt
plasticState(phase)%nTrans= 0_pInt
allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal)
allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, &
totalNslip(instance),0_pInt,0_pInt)
plasticState(phase)%offsetDeltaState = 0_pInt
plasticState(phase)%slipRate => &
plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase)
plasticState(phase)%accumulatedSlip => &
@ -1999,10 +1621,10 @@ end subroutine plastic_nonlocal_kinetics
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el)
use math, only: math_Plain3333to99, &
use math, only: math_3333to99, &
math_mul6x6, &
math_mul33xx33, &
math_Mandel6to33
math_6toSym33
use debug, only: debug_level, &
debug_constitutive, &
debug_levelExtensive, &
@ -2094,11 +1716,11 @@ do s = 1_pInt,ns
tauNS(s,1) = tau(s)
tauNS(s,2) = tau(s)
if (tau(s) > 0.0_pReal) then
tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance))
tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance))
tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance))
tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance))
else
tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance))
tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance))
tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance))
tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance))
endif
enddo
forall (t = 1_pInt:4_pInt) &
@ -2173,7 +1795,7 @@ do s = 1_pInt,ns
* burgers(s,instance)
endif
enddo
dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333)
dLp_dTstar99 = math_3333to99(dLp_dTstar3333)
#ifdef DEBUG
@ -3655,45 +3277,6 @@ forall (s = 1_pInt:ns) &
outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
select case(plastic_nonlocal_outputID(o,instance))
case (rho_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) + sum(rhoDip,2)
cs = cs + ns
case (rho_sgl_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2)
cs = cs + ns
case (rho_sgl_mobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,1:4)),2)
cs = cs + ns
case (rho_sgl_immobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:8),2)
cs = cs + ns
case (rho_dip_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDip,2)
cs = cs + ns
case (rho_edge_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1)
cs = cs + ns
case (rho_sgl_edge_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2)
cs = cs + ns
case (rho_sgl_edge_mobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,1:2),2)
cs = cs + ns
case (rho_sgl_edge_immobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:6),2)
cs = cs + ns
case (rho_sgl_edge_pos_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))
cs = cs + ns
case (rho_sgl_edge_pos_mobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1)
@ -3703,10 +3286,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5)
cs = cs + ns
case (rho_sgl_edge_neg_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))
cs = cs + ns
case (rho_sgl_edge_neg_mobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2)
cs = cs + ns
@ -3719,26 +3298,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1)
cs = cs + ns
case (rho_screw_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2)
cs = cs + ns
case (rho_sgl_screw_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2)
cs = cs + ns
case (rho_sgl_screw_mobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,3:4),2)
cs = cs + ns
case (rho_sgl_screw_immobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,7:8),2)
cs = cs + ns
case (rho_sgl_screw_pos_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))
cs = cs + ns
case (rho_sgl_screw_pos_mobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3)
cs = cs + ns
@ -3746,10 +3305,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
case (rho_sgl_screw_pos_immobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7)
cs = cs + ns
case (rho_sgl_screw_neg_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))
cs = cs + ns
case (rho_sgl_screw_neg_mobile_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4)
@ -3763,38 +3318,9 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2)
cs = cs + ns
case (excess_rho_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) &
- (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) &
+ (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) &
- (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)))
cs = cs + ns
case (excess_rho_edge_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) &
- (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6)))
cs = cs + ns
case (excess_rho_screw_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) &
- (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)))
cs = cs + ns
case (rho_forest_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoForest
cs = cs + ns
case (delta_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2) + sum(rhoDip,2))
cs = cs + ns
case (delta_sgl_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2))
cs = cs + ns
case (delta_dip_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(rhoDip,2))
cs = cs + ns
case (shearrate_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(gdot,2)
@ -3818,12 +3344,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
case (resistance_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauThreshold
cs = cs + ns
case (rho_dot_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) &
+ sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) &
+ sum(rhoDotDip,2)
cs = cs + ns
case (rho_dot_sgl_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) &
@ -3838,7 +3358,7 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2)
cs = cs + ns
case (rho_dot_gen_ID)
case (rho_dot_gen_ID) ! Obsolete
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) &
+ rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el)
cs = cs + ns
@ -3850,11 +3370,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
case (rho_dot_gen_screw_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el)
cs = cs + ns
case (rho_dot_sgl2dip_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) &
+ rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el)
cs = cs + ns
case (rho_dot_sgl2dip_edge_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el)
@ -3868,11 +3383,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) &
+ rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el)
cs = cs + ns
case (rho_dot_ann_the_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) &
+ rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el)
cs = cs + ns
case (rho_dot_ann_the_edge_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el)
@ -3890,11 +3400,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2)
cs = cs + ns
case (rho_dot_flux_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) &
+ sum(rhoDotFluxOutput(1:ns,5:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2)
cs = cs + ns
case (rho_dot_flux_edge_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) &
+ sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2)
@ -3921,78 +3426,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,4)
cs = cs + ns
case (slipdirectionx_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(1,1:ns,1)
cs = cs + ns
case (slipdirectiony_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(2,1:ns,1)
cs = cs + ns
case (slipdirectionz_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(3,1:ns,1)
cs = cs + ns
case (slipnormalx_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(1,1:ns)
cs = cs + ns
case (slipnormaly_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(2,1:ns)
cs = cs + ns
case (slipnormalz_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(3,1:ns)
cs = cs + ns
case (fluxdensity_edge_posx_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(1,1:ns,1)
cs = cs + ns
case (fluxdensity_edge_posy_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(2,1:ns,1)
cs = cs + ns
case (fluxdensity_edge_posz_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(3,1:ns,1)
cs = cs + ns
case (fluxdensity_edge_negx_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(1,1:ns,1)
cs = cs + ns
case (fluxdensity_edge_negy_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(2,1:ns,1)
cs = cs + ns
case (fluxdensity_edge_negz_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(3,1:ns,1)
cs = cs + ns
case (fluxdensity_screw_posx_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(1,1:ns,2)
cs = cs + ns
case (fluxdensity_screw_posy_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(2,1:ns,2)
cs = cs + ns
case (fluxdensity_screw_posz_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(3,1:ns,2)
cs = cs + ns
case (fluxdensity_screw_negx_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(1,1:ns,2)
cs = cs + ns
case (fluxdensity_screw_negy_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(2,1:ns,2)
cs = cs + ns
case (fluxdensity_screw_negz_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(3,1:ns,2)
cs = cs + ns
case (maximumdipoleheight_edge_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1)
cs = cs + ns
@ -4000,17 +3433,7 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
case (maximumdipoleheight_screw_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2)
cs = cs + ns
case(dislocationstress_ID)
sigma = plastic_nonlocal_dislocationstress(Fe, ip, el)
plastic_nonlocal_postResults(cs+1_pInt) = sigma(1,1)
plastic_nonlocal_postResults(cs+2_pInt) = sigma(2,2)
plastic_nonlocal_postResults(cs+3_pInt) = sigma(3,3)
plastic_nonlocal_postResults(cs+4_pInt) = sigma(1,2)
plastic_nonlocal_postResults(cs+5_pInt) = sigma(2,3)
plastic_nonlocal_postResults(cs+6_pInt) = sigma(3,1)
cs = cs + 6_pInt
case(accumulatedshear_ID)
plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of)
cs = cs + ns

499
src/plastic_phenopowerlaw.f90
View File

@ -2,12 +2,11 @@
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw
!! fitting
!> @brief phenomenological crystal plasticity formulation using a powerlaw fitting
!--------------------------------------------------------------------------------------------------
module plastic_phenopowerlaw
use prec, only: &
pReal,&
pReal, &
pInt
implicit none
@ -73,19 +72,19 @@ module plastic_phenopowerlaw
Ntwin !< number of active twin systems for each family
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID !< ID of each post result output
end type !< container type for internal constitutive parameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
end type tParameters
type, private :: tPhenopowerlawState
real(pReal), pointer, dimension(:,:) :: &
xi_slip, &
xi_twin, &
gamma_slip, &
gamma_twin, &
whole
end type
gamma_twin
end type tPhenopowerlawState
!--------------------------------------------------------------------------------------------------
! containers for parameters and state
type(tParameters), allocatable, dimension(:), private :: param
type(tPhenopowerlawState), allocatable, dimension(:), private :: &
dotState, &
state
@ -94,7 +93,11 @@ module plastic_phenopowerlaw
plastic_phenopowerlaw_init, &
plastic_phenopowerlaw_LpAndItsTangent, &
plastic_phenopowerlaw_dotState, &
plastic_phenopowerlaw_postResults
plastic_phenopowerlaw_postResults, &
plastic_phenopowerlaw_results
private :: &
kinetics_slip, &
kinetics_twin
contains
@ -110,8 +113,7 @@ subroutine plastic_phenopowerlaw_init
compiler_options
#endif
use prec, only: &
pStringLen, &
dEq0
pStringLen
use debug, only: &
debug_level, &
debug_constitutive,&
@ -119,7 +121,6 @@ subroutine plastic_phenopowerlaw_init
use math, only: &
math_expand
use IO, only: &
IO_warning, &
IO_error, &
IO_timeStamp
use material, only: &
@ -149,15 +150,14 @@ subroutine plastic_phenopowerlaw_init
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID !< ID of each post result output
outputID
character(len=pStringLen) :: &
structure = '',&
extmsg = ''
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -173,59 +173,59 @@ subroutine plastic_phenopowerlaw_init
allocate(state(Ninstance))
allocate(dotState(Ninstance))
do p = 1_pInt, size(phase_plasticityInstance)
do p = 1_pInt, size(phase_plasticity)
if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle
associate(prm => param(phase_plasticityInstance(p)), &
dot => dotState(phase_plasticityInstance(p)), &
stt => state(phase_plasticityInstance(p)))
structure = config_phase(p)%getString('lattice_structure')
stt => state(phase_plasticityInstance(p)), &
config => config_phase(p))
!--------------------------------------------------------------------------------------------------
! optional parameters that need to be defined
prm%twinB = config_phase(p)%getFloat('twin_b',defaultVal=1.0_pReal)
prm%twinC = config_phase(p)%getFloat('twin_c',defaultVal=0.0_pReal)
prm%twinD = config_phase(p)%getFloat('twin_d',defaultVal=0.0_pReal)
prm%twinE = config_phase(p)%getFloat('twin_e',defaultVal=0.0_pReal)
prm%twinB = config%getFloat('twin_b',defaultVal=1.0_pReal)
prm%twinC = config%getFloat('twin_c',defaultVal=0.0_pReal)
prm%twinD = config%getFloat('twin_d',defaultVal=0.0_pReal)
prm%twinE = config%getFloat('twin_e',defaultVal=0.0_pReal)
prm%aTolResistance = config%getFloat('atol_resistance',defaultVal=1.0_pReal)
prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal)
prm%aTolTwinfrac = config%getFloat('atol_twinfrac', defaultVal=1.0e-6_pReal)
prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal)
prm%aTolShear = config_phase(p)%getFloat('atol_shear', defaultVal=1.0e-6_pReal)
prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac', defaultVal=1.0e-6_pReal)
! sanity checks
if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//'aTolresistance '
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//'aTolShear '
if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//'atoltwinfrac '
if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//' aTolresistance'
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear'
if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//' atoltwinfrac'
!--------------------------------------------------------------------------------------------------
! slip related parameters
prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray)
prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray)
prm%totalNslip = sum(prm%Nslip)
slipActive: if (prm%totalNslip > 0_pInt) then
prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),&
config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal))
if(structure=='bcc') then
prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',&
defaultVal = emptyRealArray)
prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt)
prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt)
prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),&
config%getFloat('c/a',defaultVal=0.0_pReal))
if(trim(config%getString('lattice_structure')) == 'bcc') then
prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',&
defaultVal = emptyRealArray)
prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt)
prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt)
else
prm%nonSchmid_pos = prm%Schmid_slip
prm%nonSchmid_neg = prm%Schmid_slip
prm%nonSchmid_pos = prm%Schmid_slip
prm%nonSchmid_neg = prm%Schmid_slip
endif
prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, &
config_phase(p)%getFloats('interaction_slipslip'), &
structure(1:3))
config%getFloats('interaction_slipslip'), &
config%getString('lattice_structure'))
prm%xi_slip_0 = config_phase(p)%getFloats('tau0_slip', requiredShape=shape(prm%Nslip))
prm%xi_slip_sat = config_phase(p)%getFloats('tausat_slip', requiredShape=shape(prm%Nslip))
prm%H_int = config_phase(p)%getFloats('h_int', requiredShape=shape(prm%Nslip), &
defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))])
prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip')
prm%n_slip = config_phase(p)%getFloat('n_slip')
prm%a_slip = config_phase(p)%getFloat('a_slip')
prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip')
prm%xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(prm%Nslip))
prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip))
prm%H_int = config%getFloats('h_int', requiredSize=size(prm%Nslip), &
defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))])
prm%gdot0_slip = config%getFloat('gdot0_slip')
prm%n_slip = config%getFloat('n_slip')
prm%a_slip = config%getFloat('a_slip')
prm%h0_SlipSlip = config%getFloat('h0_slipslip')
! expand: family => system
prm%xi_slip_0 = math_expand(prm%xi_slip_0, prm%Nslip)
@ -233,11 +233,11 @@ subroutine plastic_phenopowerlaw_init
prm%H_int = math_expand(prm%H_int, prm%Nslip)
! sanity checks
if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//'gdot0_slip '
if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//'a_slip ' ! ToDo: negative values ok?
if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//'n_slip ' ! ToDo: negative values ok?
if (any(prm%xi_slip_0 <= 0.0_pReal)) extmsg = trim(extmsg)//'xi_slip_0 '
if (any(prm%xi_slip_sat < prm%xi_slip_0)) extmsg = trim(extmsg)//'xi_slip_sat '
if ( prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_slip'
if ( prm%a_slip <= 0.0_pReal) extmsg = trim(extmsg)//' a_slip'
if ( prm%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip'
if (any(prm%xi_slip_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_slip_0'
if (any(prm%xi_slip_sat <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_slip_sat'
else slipActive
allocate(prm%interaction_SlipSlip(0,0))
allocate(prm%xi_slip_0(0))
@ -245,30 +245,30 @@ subroutine plastic_phenopowerlaw_init
!--------------------------------------------------------------------------------------------------
! twin related parameters
prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray)
prm%Ntwin = config%getInts('ntwin', defaultVal=emptyIntArray)
prm%totalNtwin = sum(prm%Ntwin)
twinActive: if (prm%totalNtwin > 0_pInt) then
prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,structure(1:3),&
config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal))
prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,config%getString('lattice_structure'),&
config%getFloat('c/a',defaultVal=0.0_pReal))
prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,&
config_phase(p)%getFloats('interaction_twintwin'), &
structure(1:3))
prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,structure(1:3),&
config_phase(p)%getFloat('c/a'))
config%getFloats('interaction_twintwin'), &
config%getString('lattice_structure'))
prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,config%getString('lattice_structure'),&
config%getFloat('c/a'))
prm%xi_twin_0 = config_phase(p)%getFloats('tau0_twin',requiredShape=shape(prm%Ntwin))
prm%xi_twin_0 = config%getFloats('tau0_twin',requiredSize=size(prm%Ntwin))
prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin')
prm%n_twin = config_phase(p)%getFloat('n_twin')
prm%spr = config_phase(p)%getFloat('s_pr')
prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin')
prm%gdot0_twin = config%getFloat('gdot0_twin')
prm%n_twin = config%getFloat('n_twin')
prm%spr = config%getFloat('s_pr')
prm%h0_TwinTwin = config%getFloat('h0_twintwin')
! expand: family => system
prm%xi_twin_0 = math_expand(prm%xi_twin_0, prm%Ntwin)
! sanity checks
if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//'gdot0_twin '
if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//'n_twin ' ! ToDo: negative values ok?
if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_twin'
if (prm%n_twin <= 0.0_pReal) extmsg = trim(extmsg)//' n_twin'
else twinActive
allocate(prm%interaction_TwinTwin(0,0))
allocate(prm%xi_twin_0(0))
@ -279,11 +279,11 @@ subroutine plastic_phenopowerlaw_init
! slip-twin related parameters
slipAndTwinActive: if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then
prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,&
config_phase(p)%getFloats('interaction_sliptwin'), &
structure(1:3))
config%getFloats('interaction_sliptwin'), &
config%getString('lattice_structure'))
prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,&
config_phase(p)%getFloats('interaction_twinslip'), &
structure(1:3))
config%getFloats('interaction_twinslip'), &
config%getString('lattice_structure'))
else slipAndTwinActive
allocate(prm%interaction_SlipTwin(prm%totalNslip,prm%TotalNtwin)) ! at least one dimension is 0
allocate(prm%interaction_TwinSlip(prm%totalNtwin,prm%TotalNslip)) ! at least one dimension is 0
@ -297,59 +297,59 @@ subroutine plastic_phenopowerlaw_init
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray)
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('resistance_slip')
outputID = merge(resistance_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
case ('accumulatedshear_slip')
outputID = merge(accumulatedshear_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
case ('shearrate_slip')
outputID = merge(shearrate_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
case ('resolvedstress_slip')
outputID = merge(resolvedstress_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
case ('resistance_twin')
outputID = merge(resistance_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
case ('accumulatedshear_twin')
outputID = merge(accumulatedshear_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
case ('shearrate_twin')
outputID = merge(shearrate_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
case ('resolvedstress_twin')
outputID = merge(resolvedstress_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
case ('resistance_slip')
outputID = merge(resistance_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
case ('accumulatedshear_slip')
outputID = merge(accumulatedshear_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
case ('shearrate_slip')
outputID = merge(shearrate_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
case ('resolvedstress_slip')
outputID = merge(resolvedstress_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
outputSize = prm%totalNslip
end select
case ('resistance_twin')
outputID = merge(resistance_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
case ('accumulatedshear_twin')
outputID = merge(accumulatedshear_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
case ('shearrate_twin')
outputID = merge(shearrate_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
case ('resolvedstress_twin')
outputID = merge(resolvedstress_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
outputSize = prm%totalNtwin
if (outputID /= undefined_ID) then
plastic_phenopowerlaw_output(i,phase_plasticityInstance(p)) = outputs(i)
plastic_phenopowerlaw_sizePostResult(i,phase_plasticityInstance(p)) = outputSize
prm%outputID = [prm%outputID , outputID]
endif
end select
end do
if (outputID /= undefined_ID) then
plastic_phenopowerlaw_output(i,phase_plasticityInstance(p)) = outputs(i)
plastic_phenopowerlaw_sizePostResult(i,phase_plasticityInstance(p)) = outputSize
prm%outputID = [prm%outputID, outputID]
endif
enddo
!--------------------------------------------------------------------------------------------------
! allocate state arrays
NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase
sizeState = size(['tau_slip ','gamma_slip']) * prm%TotalNslip &
+ size(['tau_twin ','gamma_twin']) * prm%TotalNtwin
sizeDotState = sizeState
NipcMyPhase = count(material_phase == p)
sizeDotState = size(['tau_slip ','gamma_slip']) * prm%totalNslip &
+ size(['tau_twin ','gamma_twin']) * prm%totalNtwin
sizeState = sizeDotState
call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, &
prm%totalNslip,prm%totalNtwin,0_pInt)
plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,phase_plasticityInstance(p)))
!--------------------------------------------------------------------------------------------------
! locally defined state aliases and initialization of state0 and aTolState
startIndex = 1_pInt
@ -381,10 +381,10 @@ subroutine plastic_phenopowerlaw_init
dot%gamma_twin => plasticState(p)%dotState(startIndex:endIndex,:)
plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear
plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally
dot%whole => plasticState(p)%dotState
plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally
end associate
enddo
end subroutine plastic_phenopowerlaw_init
@ -392,13 +392,13 @@ end subroutine plastic_phenopowerlaw_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!> @details asumme that deformation by dislocation glide affects twinned and untwinned volume
! equally (Taylor assumption). Twinning happens only in untwinned volume (
!> @details asummes that deformation by dislocation glide affects twinned and untwinned volume
! equally (Taylor assumption). Twinning happens only in untwinned volume
!--------------------------------------------------------------------------------------------------
subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
implicit none
real(pReal), dimension(3,3), intent(out) :: &
real(pReal), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
real(pReal), dimension(3,3,3,3), intent(out) :: &
dLp_dMp !< derivative of Lp with respect to the Mandel stress
@ -412,17 +412,17 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
integer(pInt) :: &
i,k,l,m,n
real(pReal), dimension(param(instance)%totalNslip) :: &
dgdot_dtauslip_pos,dgdot_dtauslip_neg, &
gdot_slip_pos,gdot_slip_neg
gdot_slip_pos,gdot_slip_neg, &
dgdot_dtauslip_pos,dgdot_dtauslip_neg
real(pReal), dimension(param(instance)%totalNtwin) :: &
gdot_twin,dgdot_dtautwin
Lp = 0.0_pReal
dLp_dMp = 0.0_pReal
associate(prm => param(instance), stt => state(instance))
call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg)
associate(prm => param(instance))
call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg)
slipSystems: do i = 1_pInt, prm%totalNslip
Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
@ -431,14 +431,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
+ dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_neg(m,n,i)
enddo slipSystems
call kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtautwin)
call kinetics_twin(Mp,instance,of,gdot_twin,dgdot_dtautwin)
twinSystems: do i = 1_pInt, prm%totalNtwin
Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
+ dgdot_dtautwin(i)*prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i)
enddo twinSystems
end associate
end subroutine plastic_phenopowerlaw_LpAndItsTangent
@ -452,7 +452,7 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of)
implicit none
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
integer(pInt), intent(in) :: &
instance, &
of
@ -466,9 +466,8 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of)
left_SlipSlip,right_SlipSlip, &
gdot_slip_pos,gdot_slip_neg
associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
dot%whole(:,of) = 0.0_pReal
sumGamma = sum(stt%gamma_slip(:,of))
sumF = sum(stt%gamma_twin(:,of)/prm%gamma_twin_char)
@ -487,9 +486,9 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of)
!--------------------------------------------------------------------------------------------------
! shear rates
call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg)
call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg)
dot%gamma_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg)
call kinetics_twin(prm,stt,of,Mp,dot%gamma_twin(:,of))
call kinetics_twin(Mp,instance,of,dot%gamma_twin(:,of))
!--------------------------------------------------------------------------------------------------
! hardening
@ -510,40 +509,137 @@ end subroutine plastic_phenopowerlaw_dotState
!--------------------------------------------------------------------------------------------------
!> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress
!> @details Shear rates are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, &
dgdot_dtau_slip_pos,dgdot_dtau_slip_neg)
use prec, only: &
dNeq0
function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults)
use math, only: &
math_mul33xx33
implicit none
type(tParameters), intent(in) :: &
prm
type(tPhenopowerlawState), intent(in) :: &
stt
integer(pInt), intent(in) :: &
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
instance, &
of
real(pReal), dimension(prm%totalNslip), intent(out) :: &
real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: &
postResults
integer(pInt) :: &
o,c,i
real(pReal), dimension(param(instance)%totalNslip) :: &
gdot_slip_pos,gdot_slip_neg
c = 0_pInt
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
case (resistance_slip_ID)
postResults(c+1_pInt:c+prm%totalNslip) = stt%xi_slip(1:prm%totalNslip,of)
c = c + prm%totalNslip
case (accumulatedshear_slip_ID)
postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of)
c = c + prm%totalNslip
case (shearrate_slip_ID)
call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg)
postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg
c = c + prm%totalNslip
case (resolvedstress_slip_ID)
do i = 1_pInt, prm%totalNslip
postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i))
enddo
c = c + prm%totalNslip
case (resistance_twin_ID)
postResults(c+1_pInt:c+prm%totalNtwin) = stt%xi_twin(1:prm%totalNtwin,of)
c = c + prm%totalNtwin
case (accumulatedshear_twin_ID)
postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of)
c = c + prm%totalNtwin
case (shearrate_twin_ID)
call kinetics_twin(Mp,instance,of,postResults(c+1_pInt:c+prm%totalNtwin))
c = c + prm%totalNtwin
case (resolvedstress_twin_ID)
do i = 1_pInt, prm%totalNtwin
postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i))
enddo
c = c + prm%totalNtwin
end select
enddo outputsLoop
end associate
end function plastic_phenopowerlaw_postResults
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine plastic_phenopowerlaw_results(instance,group)
#if defined(PETSc) || defined(DAMASKHDF5)
use results
implicit none
integer(pInt), intent(in) :: instance
character(len=*) :: group
integer(pInt) :: o
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
case (resistance_slip_ID)
call results_writeVectorDataset(group,stt%xi_slip,'xi_slip','Pa')
case (accumulatedshear_slip_ID)
call results_writeVectorDataset(group,stt%gamma_slip,'gamma_slip','-')
end select
enddo outputsLoop
end associate
#else
integer(pInt), intent(in) :: instance
character(len=*) :: group
#endif
end subroutine plastic_phenopowerlaw_results
!--------------------------------------------------------------------------------------------------
!> @brief Shear rates on slip systems and their derivatives with respect to resolved stress
!> @details Derivatives are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_slip(Mp,instance,of, &
gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg)
use prec, only: &
dNeq0
use math, only: &
math_mul33xx33
implicit none
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
instance, &
of
real(pReal), intent(out), dimension(param(instance)%totalNslip) :: &
gdot_slip_pos, &
gdot_slip_neg
real(pReal), dimension(prm%totalNslip), optional, intent(out) :: &
real(pReal), intent(out), optional, dimension(param(instance)%totalNslip) :: &
dgdot_dtau_slip_pos, &
dgdot_dtau_slip_neg
real(pReal), dimension(3,3), intent(in) :: &
Mp
real(pReal), dimension(prm%totalNslip) :: &
real(pReal), dimension(param(instance)%totalNslip) :: &
tau_slip_pos, &
tau_slip_neg
integer(pInt) :: i
logical :: nonSchmidActive
associate(prm => param(instance), stt => state(instance))
nonSchmidActive = size(prm%nonSchmidCoeff) > 0_pInt
do i = 1_pInt, prm%totalNslip
@ -560,7 +656,7 @@ pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, &
end where
where(dNeq0(tau_slip_neg))
gdot_slip_neg = 0.5_pReal*prm%gdot0_slip &
gdot_slip_neg = prm%gdot0_slip * 0.5_pReal & ! only used if non-Schmid active, always 1/2
* sign(abs(tau_slip_neg/stt%xi_slip(:,of))**prm%n_slip, tau_slip_neg)
else where
gdot_slip_neg = 0.0_pReal
@ -580,49 +676,51 @@ pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, &
dgdot_dtau_slip_neg = 0.0_pReal
end where
endif
end associate
end subroutine kinetics_slip
!--------------------------------------------------------------------------------------------------
!> @brief calculates shear rates on twin systems and derivatives with respect to resolved stress.
!> @brief Shear rates on twin systems and their derivatives with respect to resolved stress.
! twinning is assumed to take place only in untwinned volume.
!> @details Derivates are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end.
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtau_twin)
pure subroutine kinetics_twin(Mp,instance,of,&
gdot_twin,dgdot_dtau_twin)
use prec, only: &
dNeq0
use math, only: &
math_mul33xx33
implicit none
type(tParameters), intent(in) :: &
prm
type(tPhenopowerlawState), intent(in) :: &
stt
integer(pInt), intent(in) :: &
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
instance, &
of
real(pReal), dimension(3,3), intent(in) :: &
Mp
real(pReal), dimension(prm%totalNtwin), intent(out) :: &
real(pReal), dimension(param(instance)%totalNtwin), intent(out) :: &
gdot_twin
real(pReal), dimension(prm%totalNtwin), optional, intent(out) :: &
real(pReal), dimension(param(instance)%totalNtwin), intent(out), optional :: &
dgdot_dtau_twin
real(pReal), dimension(prm%totalNtwin) :: &
real(pReal), dimension(param(instance)%totalNtwin) :: &
tau_twin
integer(pInt) :: i
associate(prm => param(instance), stt => state(instance))
do i = 1_pInt, prm%totalNtwin
tau_twin(i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i))
enddo
where(tau_twin > 0.0_pReal)
gdot_twin = (1.0_pReal-sum(stt%gamma_twin(:,of)/prm%gamma_twin_char)) & ! only twin in untwinned volume fraction
* prm%gdot0_twin*(abs(tau_twin)/stt%xi_twin(:,of))**prm%n_twin
else where
else where
gdot_twin = 0.0_pReal
end where
@ -634,75 +732,8 @@ pure subroutine kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtau_twin)
end where
endif
end subroutine kinetics_twin
!--------------------------------------------------------------------------------------------------
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults)
use math, only: &
math_mul33xx33
implicit none
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer(pInt), intent(in) :: &
instance, &
of
real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: &
postResults
integer(pInt) :: &
o,c,i
real(pReal), dimension(param(instance)%totalNslip) :: &
gdot_slip_pos,gdot_slip_neg
postResults = 0.0_pReal
c = 0_pInt
associate( prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
case (resistance_slip_ID)
postResults(c+1_pInt:c+prm%totalNslip) = stt%xi_slip(1:prm%totalNslip,of)
c = c + prm%totalNslip
case (accumulatedshear_slip_ID)
postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of)
c = c + prm%totalNslip
case (shearrate_slip_ID)
call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg)
postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg
c = c + prm%totalNslip
case (resolvedstress_slip_ID)
do i = 1_pInt, prm%totalNslip
postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i))
enddo
c = c + prm%totalNslip
case (resistance_twin_ID)
postResults(c+1_pInt:c+prm%totalNtwin) = stt%xi_twin(1:prm%totalNtwin,of)
c = c + prm%totalNtwin
case (accumulatedshear_twin_ID)
postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of)
c = c + prm%totalNtwin
case (shearrate_twin_ID)
call kinetics_twin(prm,stt,of,Mp,postResults(c+1_pInt:c+prm%totalNtwin))
c = c + prm%totalNtwin
case (resolvedstress_twin_ID)
do i = 1_pInt, prm%totalNtwin
postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i))
enddo
c = c + prm%totalNtwin
end select
enddo outputsLoop
end associate
end function plastic_phenopowerlaw_postResults
end subroutine kinetics_twin
end module plastic_phenopowerlaw

60
src/porosity_none.f90
View File

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

448
src/porosity_phasefield.f90
View File

@ -1,448 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for phase field modelling of pore nucleation and growth
!> @details phase field model for pore nucleation and growth based on vacancy clustering
!--------------------------------------------------------------------------------------------------
module porosity_phasefield
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
porosity_phasefield_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
porosity_phasefield_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
porosity_phasefield_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
porosity_phasefield_Noutput !< number of outputs per instance of this porosity
enum, bind(c)
enumerator :: undefined_ID, &
porosity_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
porosity_phasefield_outputID !< ID of each post result output
public :: &
porosity_phasefield_init, &
porosity_phasefield_getFormationEnergy, &
porosity_phasefield_getSurfaceEnergy, &
porosity_phasefield_getSourceAndItsTangent, &
porosity_phasefield_getDiffusion33, &
porosity_phasefield_getMobility, &
porosity_phasefield_putPorosity, &
porosity_phasefield_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine porosity_phasefield_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
porosity_type, &
porosity_typeInstance, &
homogenization_Noutput, &
POROSITY_phasefield_label, &
POROSITY_phasefield_ID, &
material_homog, &
mappingHomogenization, &
porosityState, &
porosityMapping, &
porosity, &
porosity_initialPhi
use config, only: &
material_partHomogenization, &
material_partPhase
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(porosity_phasefield_sizePostResults(maxNinstance), source=0_pInt)
allocate(porosity_phasefield_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(porosity_phasefield_output (maxval(homogenization_Noutput),maxNinstance))
porosity_phasefield_output = ''
allocate(porosity_phasefield_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(porosity_phasefield_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next homog section
section = section + 1_pInt ! advance homog section counter
cycle ! skip to next line
endif
if (section > 0_pInt ) then; if (porosity_type(section) == POROSITY_phasefield_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = porosity_typeInstance(section) ! which instance of my porosity is present homog
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('porosity')
porosity_phasefield_Noutput(instance) = porosity_phasefield_Noutput(instance) + 1_pInt
porosity_phasefield_outputID(porosity_phasefield_Noutput(instance),instance) = porosity_ID
porosity_phasefield_output(porosity_phasefield_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
end select
endif; endif
enddo parsingHomog
initializeInstances: do section = 1_pInt, size(porosity_type)
if (porosity_type(section) == POROSITY_phasefield_ID) then
NofMyHomog=count(material_homog==section)
instance = porosity_typeInstance(section)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,porosity_phasefield_Noutput(instance)
select case(porosity_phasefield_outputID(o,instance))
case(porosity_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
porosity_phasefield_sizePostResult(o,instance) = mySize
porosity_phasefield_sizePostResults(instance) = porosity_phasefield_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! allocate state arrays
sizeState = 0_pInt
porosityState(section)%sizeState = sizeState
porosityState(section)%sizePostResults = porosity_phasefield_sizePostResults(instance)
allocate(porosityState(section)%state0 (sizeState,NofMyHomog))
allocate(porosityState(section)%subState0(sizeState,NofMyHomog))
allocate(porosityState(section)%state (sizeState,NofMyHomog))
nullify(porosityMapping(section)%p)
porosityMapping(section)%p => mappingHomogenization(1,:,:)
deallocate(porosity(section)%p)
allocate(porosity(section)%p(NofMyHomog), source=porosity_initialPhi(section))
endif
enddo initializeInstances
end subroutine porosity_phasefield_init
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized vacancy formation energy
!--------------------------------------------------------------------------------------------------
function porosity_phasefield_getFormationEnergy(ip,el)
use lattice, only: &
lattice_vacancyFormationEnergy, &
lattice_vacancyVol
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal) :: &
porosity_phasefield_getFormationEnergy
integer(pInt) :: &
grain
porosity_phasefield_getFormationEnergy = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
porosity_phasefield_getFormationEnergy = porosity_phasefield_getFormationEnergy + &
lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ &
lattice_vacancyVol(material_phase(grain,ip,el))
enddo
porosity_phasefield_getFormationEnergy = &
porosity_phasefield_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function porosity_phasefield_getFormationEnergy
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized pore surface energy (normalized by characteristic length)
!--------------------------------------------------------------------------------------------------
function porosity_phasefield_getSurfaceEnergy(ip,el)
use lattice, only: &
lattice_vacancySurfaceEnergy
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal) :: &
porosity_phasefield_getSurfaceEnergy
integer(pInt) :: &
grain
porosity_phasefield_getSurfaceEnergy = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
porosity_phasefield_getSurfaceEnergy = porosity_phasefield_getSurfaceEnergy + &
lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
enddo
porosity_phasefield_getSurfaceEnergy = &
porosity_phasefield_getSurfaceEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function porosity_phasefield_getSurfaceEnergy
!--------------------------------------------------------------------------------------------------
!> @brief calculates homogenized local driving force for pore nucleation and growth
!--------------------------------------------------------------------------------------------------
subroutine porosity_phasefield_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
use math, only : &
math_mul33x33, &
math_mul66x6, &
math_Mandel33to6, &
math_transpose33, &
math_I3
use material, only: &
homogenization_Ngrains, &
material_homog, &
material_phase, &
phase_NstiffnessDegradations, &
phase_stiffnessDegradation, &
vacancyConc, &
vacancyfluxMapping, &
damage, &
damageMapping, &
STIFFNESS_DEGRADATION_damage_ID
use crystallite, only: &
crystallite_Fe
use constitutive, only: &
constitutive_homogenizedC
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
phi
integer(pInt) :: &
phase, &
grain, &
homog, &
mech
real(pReal) :: &
phiDot, dPhiDot_dPhi, Cv, W_e, strain(6), C(6,6)
homog = material_homog(ip,el)
Cv = vacancyConc(homog)%p(vacancyfluxMapping(homog)%p(ip,el))
W_e = 0.0_pReal
do grain = 1, homogenization_Ngrains(homog)
phase = material_phase(grain,ip,el)
strain = math_Mandel33to6(math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,grain,ip,el)), &
crystallite_Fe(1:3,1:3,grain,ip,el)) - math_I3)/2.0_pReal
C = constitutive_homogenizedC(grain,ip,el)
do mech = 1_pInt, phase_NstiffnessDegradations(phase)
select case(phase_stiffnessDegradation(mech,phase))
case (STIFFNESS_DEGRADATION_damage_ID)
C = damage(homog)%p(damageMapping(homog)%p(ip,el))* &
damage(homog)%p(damageMapping(homog)%p(ip,el))* &
C
end select
enddo
W_e = W_e + sum(abs(strain*math_mul66x6(C,strain)))
enddo
W_e = W_e/real(homogenization_Ngrains(homog),pReal)
phiDot = 2.0_pReal*(1.0_pReal - phi)*(1.0_pReal - Cv)*(1.0_pReal - Cv) - &
2.0_pReal*phi*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ &
porosity_phasefield_getSurfaceEnergy (ip,el)
dPhiDot_dPhi = - 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - Cv) &
- 2.0_pReal*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ &
porosity_phasefield_getSurfaceEnergy (ip,el)
end subroutine porosity_phasefield_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized nonlocal diffusion tensor in reference configuration
!--------------------------------------------------------------------------------------------------
function porosity_phasefield_getDiffusion33(ip,el)
use lattice, only: &
lattice_PorosityDiffusion33
use material, only: &
homogenization_Ngrains, &
material_phase, &
mappingHomogenization
use crystallite, only: &
crystallite_push33ToRef
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
porosity_phasefield_getDiffusion33
integer(pInt) :: &
homog, &
grain
homog = mappingHomogenization(2,ip,el)
porosity_phasefield_getDiffusion33 = 0.0_pReal
do grain = 1, homogenization_Ngrains(homog)
porosity_phasefield_getDiffusion33 = porosity_phasefield_getDiffusion33 + &
crystallite_push33ToRef(grain,ip,el,lattice_PorosityDiffusion33(1:3,1:3,material_phase(grain,ip,el)))
enddo
porosity_phasefield_getDiffusion33 = &
porosity_phasefield_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
end function porosity_phasefield_getDiffusion33
!--------------------------------------------------------------------------------------------------
!> @brief Returns homogenized phase field mobility
!--------------------------------------------------------------------------------------------------
real(pReal) function porosity_phasefield_getMobility(ip,el)
use mesh, only: &
mesh_element
use lattice, only: &
lattice_PorosityMobility
use material, only: &
material_phase, &
homogenization_Ngrains
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
integer(pInt) :: &
ipc
porosity_phasefield_getMobility = 0.0_pReal
do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
porosity_phasefield_getMobility = porosity_phasefield_getMobility &
+ lattice_PorosityMobility(material_phase(ipc,ip,el))
enddo
porosity_phasefield_getMobility = &
porosity_phasefield_getMobility/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function porosity_phasefield_getMobility
!--------------------------------------------------------------------------------------------------
!> @brief updates porosity with solution from phasefield PDE
!--------------------------------------------------------------------------------------------------
subroutine porosity_phasefield_putPorosity(phi,ip,el)
use material, only: &
material_homog, &
porosityMapping, &
porosity
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
phi
integer(pInt) :: &
homog, &
offset
homog = material_homog(ip,el)
offset = porosityMapping(homog)%p(ip,el)
porosity(homog)%p(offset) = phi
end subroutine porosity_phasefield_putPorosity
!--------------------------------------------------------------------------------------------------
!> @brief return array of porosity results
!--------------------------------------------------------------------------------------------------
function porosity_phasefield_postResults(ip,el)
use material, only: &
mappingHomogenization, &
porosity_typeInstance, &
porosity
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(porosity_phasefield_sizePostResults(porosity_typeInstance(mappingHomogenization(2,ip,el)))) :: &
porosity_phasefield_postResults
integer(pInt) :: &
instance, homog, offset, o, c
homog = mappingHomogenization(2,ip,el)
offset = mappingHomogenization(1,ip,el)
instance = porosity_typeInstance(homog)
c = 0_pInt
porosity_phasefield_postResults = 0.0_pReal
do o = 1_pInt,porosity_phasefield_Noutput(instance)
select case(porosity_phasefield_outputID(o,instance))
case (porosity_ID)
porosity_phasefield_postResults(c+1_pInt) = porosity(homog)%p(offset)
c = c + 1
end select
enddo
end function porosity_phasefield_postResults
end module porosity_phasefield

2
src/quit.f90
View File

@ -23,6 +23,8 @@ subroutine quit(stop_id)
integer(pInt) :: error = 0_pInt
PetscErrorCode :: ierr = 0
call h5open_f(hdferr)
if (hdferr /= 0) write(6,'(a,i5)') ' Error in h5open_f',hdferr ! prevents error if not opened yet
call h5close_f(hdferr)
if (hdferr /= 0) write(6,'(a,i5)') ' Error in h5close_f',hdferr

974
src/results.f90 Normal file
View File

@ -0,0 +1,974 @@
!--------------------------------------------------------------------------------------------------
!> @author Vitesh Shah, Max-Planck-Institut für Eisenforschung GmbH
!> @author Yi-Chin Yang, Max-Planck-Institut für Eisenforschung GmbH
!> @author Jennifer Nastola, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!--------------------------------------------------------------------------------------------------
module results
use prec
use IO
use HDF5
use HDF5_utilities
#ifdef PETSc
use PETSC
#endif
implicit none
private
integer(HID_T), public, protected :: tempCoordinates, tempResults
integer(HID_T), private :: resultsFile, currentIncID, plist_id
public :: &
results_init, &
results_openJobFile, &
results_closeJobFile, &
results_addIncrement, &
results_addGroup, &
results_openGroup, &
results_writeVectorDataset, &
results_setLink, &
results_removeLink
contains
subroutine results_init
use, intrinsic :: &
iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use DAMASK_interface, only: &
getSolverJobName
implicit none
write(6,'(/,a)') ' <<<+- results init -+>>>'
#include "compilation_info.f90"
call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.))
end subroutine results_init
!--------------------------------------------------------------------------------------------------
!> @brief opens the results file to append data
!--------------------------------------------------------------------------------------------------
subroutine results_openJobFile()
use DAMASK_interface, only: &
getSolverJobName
implicit none
character(len=pStringLen) :: commandLine
resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.)
call HDF5_addAttribute(resultsFile,'DADF5',0.1_pReal)
call HDF5_addAttribute(resultsFile,'DAMASK',DAMASKVERSION)
call get_command(commandLine)
call HDF5_addAttribute(resultsFile,'call',trim(commandLine))
end subroutine results_openJobFile
!--------------------------------------------------------------------------------------------------
!> @brief closes the results file
!--------------------------------------------------------------------------------------------------
subroutine results_closeJobFile()
implicit none
call HDF5_closeFile(resultsFile)
end subroutine results_closeJobFile
!--------------------------------------------------------------------------------------------------
!> @brief closes the results file
!--------------------------------------------------------------------------------------------------
subroutine results_addIncrement(inc,time)
implicit none
integer(pInt), intent(in) :: inc
real(pReal), intent(in) :: time
character(len=pStringLen) :: incChar
write(incChar,*) inc
call HDF5_closeGroup(results_addGroup(trim('inc'//trim(adjustl(incChar)))))
call results_setLink(trim('inc'//trim(adjustl(incChar))),'current')
call HDF5_addAttribute(resultsFile,'time/s',time,trim('inc'//trim(adjustl(incChar))))
end subroutine results_addIncrement
!--------------------------------------------------------------------------------------------------
!> @brief open a group from the results file
!--------------------------------------------------------------------------------------------------
integer(HID_T) function results_openGroup(groupName)
implicit none
character(len=*), intent(in) :: groupName
results_openGroup = HDF5_openGroup(resultsFile,groupName)
end function results_openGroup
!--------------------------------------------------------------------------------------------------
!> @brief adds a new group to the results file
!--------------------------------------------------------------------------------------------------
integer(HID_T) function results_addGroup(groupName)
implicit none
character(len=*), intent(in) :: groupName
results_addGroup = HDF5_addGroup(resultsFile,groupName)
end function results_addGroup
!--------------------------------------------------------------------------------------------------
!> @brief set link to object in results file
!--------------------------------------------------------------------------------------------------
subroutine results_setLink(path,link)
use hdf5_utilities, only: &
HDF5_setLink
implicit none
character(len=*), intent(in) :: path, link
call HDF5_setLink(resultsFile,path,link)
end subroutine results_setLink
!--------------------------------------------------------------------------------------------------
!> @brief remove link to an object
!--------------------------------------------------------------------------------------------------
subroutine results_removeLink(link)
use hdf5
implicit none
character(len=*), intent(in) :: link
integer :: hdferr
call h5ldelete_f(resultsFile,link, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'results_removeLink: h5ldelete_soft_f ('//trim(link)//')')
end subroutine results_removeLink
!--------------------------------------------------------------------------------------------------
!> @brief stores a vector dataset in a group
!--------------------------------------------------------------------------------------------------
subroutine results_writeVectorDataset(group,dataset,label,SIunit)
implicit none
character(len=*), intent(in) :: SIunit,label,group
real(pReal), intent(inout), dimension(:,:) :: dataset
integer(HID_T) :: groupHandle
groupHandle = results_openGroup(group)
call HDF5_write(groupHandle,dataset,label)
if (HDF5_objectExists(groupHandle,label)) &
call HDF5_addAttribute(groupHandle,'Unit',SIunit,label)
call HDF5_closeGroup(groupHandle)
end subroutine results_writeVectorDataset
!--------------------------------------------------------------------------------------------------
!> @brief adds the unique mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine HDF5_mappingPhase(mapping,mapping2,Nconstituents,material_phase,phase_name,dataspace_size,mpiOffset,mpiOffset_phase)
use hdf5
implicit none
integer(pInt), intent(in) :: Nconstituents, dataspace_size, mpiOffset
integer(pInt), intent(in), dimension(:) :: mapping, mapping2
character(len=*), intent(in), dimension(:) :: phase_name
integer(pInt), intent(in), dimension(:) :: mpiOffset_phase
integer(pInt), intent(in), dimension(:,:,:) :: material_phase
character(len=len(phase_name(1))), dimension(:), allocatable :: namesNA
character(len=len(phase_name(1))) :: a
character(len=*), parameter :: n = "NULL"
integer(pInt) :: hdferr, NmatPoints, i, j, k
integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace
integer(HID_T) :: dt5_id ! Memory datatype identifier
integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size
integer(HSIZE_T), dimension(2) :: counter
integer(HSSIZE_T), dimension(2) :: fileOffset
integer(pInt), dimension(:,:), allocatable :: arrOffset
a = n
allocate(namesNA(0:size(phase_name)),source=[a,phase_name])
NmatPoints = size(mapping,1)/Nconstituents
mapping_ID = results_openGroup("current/mapGeometry")
allocate(arrOffset(Nconstituents,NmatPoints))
do i=1_pInt, NmatPoints
do k=1_pInt, Nconstituents
do j=1_pInt, size(phase_name)
if(material_phase(k,1,i) == j) &
arrOffset(k,i) = mpiOffset_phase(j)
enddo
enddo
enddo
!--------------------------------------------------------------------------------------------------
! create dataspace
call h5screate_simple_f(2, int([Nconstituents,dataspace_size],HSIZE_T), space_id, hdferr, &
int([Nconstituents,dataspace_size],HSIZE_T))
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping')
!--------------------------------------------------------------------------------------------------
! compound type
! First calculate total size by calculating sizes of each member
!
CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr)
typesize = len(phase_name(1))
CALL h5tset_size_f(dt5_id, typesize, hdferr)
CALL h5tget_size_f(dt5_id, type_sizec, hdferr)
CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr)
type_size = type_sizec + type_sizei
call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id')
call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 0')
call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 2')
!--------------------------------------------------------------------------------------------------
! create Dataset
call h5dcreate_f(mapping_id, 'constitutive', dtype_id, space_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase')
!--------------------------------------------------------------------------------------------------
! Create memory types (one compound datatype for each member)
call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f instance_id')
call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f instance_id')
call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f position_id')
call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f position_id')
!--------------------------------------------------------------------------------------------------
! Define and select hyperslabs
counter(1) = Nconstituents ! how big i am
counter(2) = NmatPoints
fileOffset(1) = 0 ! where i start to write my data
fileOffset(2) = mpiOffset
call h5screate_simple_f(2, counter, memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5screate_simple_f')
call h5dget_space_f(dset_id, space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dget_space_f')
call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sselect_hyperslab_f')
!--------------------------------------------------------------------------------------------------
! Create property list for collective dataset write
#ifdef PETSc
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pcreate_f')
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pset_dxpl_mpio_f')
#endif
!--------------------------------------------------------------------------------------------------
! write data by fields in the datatype. Fields order is not important.
call h5dwrite_f(dset_id, name_id, reshape(namesNA(mapping),[Nconstituents,NmatPoints]), &
int([Nconstituents, dataspace_size],HSIZE_T), hdferr, &
file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f position_id')
call h5dwrite_f(dset_id, position_id, reshape(mapping2-1_pInt,[Nconstituents,NmatPoints])+arrOffset, &
int([Nconstituents, dataspace_size],HSIZE_T), hdferr, &
file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f instance_id')
!--------------------------------------------------------------------------------------------------
! close types, dataspaces
call h5tclose_f(dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dtype_id')
call h5tclose_f(position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f position_id')
call h5tclose_f(name_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f name_id ')
call h5tclose_f(dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dt5_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dclose_f')
call h5sclose_f(space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f space_id')
call h5sclose_f(memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f memspace')
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pclose_f')
call HDF5_closeGroup(mapping_ID)
end subroutine HDF5_mappingPhase
!--------------------------------------------------------------------------------------------------
!> @brief adds the backward mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase)
use hdf5
implicit none
integer(pInt), intent(in), dimension(:,:,:) :: material_phase, phasememberat
character(len=*), intent(in), dimension(:) :: phase_name
integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_phase
integer(pInt), intent(in) :: mpiOffset
integer(pInt) :: hdferr, NmatPoints, Nconstituents, i, j
integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace
integer(SIZE_T) :: type_size
integer(pInt), dimension(:,:), allocatable :: arr
integer(HSIZE_T), dimension(1) :: counter
integer(HSSIZE_T), dimension(1) :: fileOffset
character(len=64) :: phaseID
Nconstituents = size(phasememberat,1)
NmatPoints = count(material_phase /=0_pInt)/Nconstituents
allocate(arr(2,NmatPoints*Nconstituents))
do i=1_pInt, NmatPoints
do j=Nconstituents-1_pInt, 0_pInt, -1_pInt
arr(1,Nconstituents*i-j) = i-1_pInt
enddo
enddo
arr(2,:) = pack(material_phase,material_phase/=0_pInt)
do i=1_pInt, size(phase_name)
write(phaseID, '(i0)') i
mapping_ID = results_openGroup('/current/constitutive/'//trim(phaseID)//'_'//phase_name(i))
NmatPoints = count(material_phase == i)
!--------------------------------------------------------------------------------------------------
! create dataspace
call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, &
int([dataspace_size(i)],HSIZE_T))
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping')
!--------------------------------------------------------------------------------------------------
! compound type
call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr)
call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id')
call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f 0')
!--------------------------------------------------------------------------------------------------
! create Dataset
call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase')
!--------------------------------------------------------------------------------------------------
! Create memory types (one compound datatype for each member)
call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tcreate_f position_id')
call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f position_id')
!--------------------------------------------------------------------------------------------------
! Define and select hyperslabs
counter = NmatPoints ! how big i am
fileOffset = mpiOffset_phase(i) ! where i start to write my data
call h5screate_simple_f(1, counter, memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5screate_simple_f')
call h5dget_space_f(dset_id, space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dget_space_f')
call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sselect_hyperslab_f')
!--------------------------------------------------------------------------------------------------
! Create property list for collective dataset write
#ifdef PETSc
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f')
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f')
#endif
!--------------------------------------------------------------------------------------------------
! write data by fields in the datatype. Fields order is not important.
call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset, int([dataspace_size(i)],HSIZE_T),&
hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dwrite_f instance_id')
!--------------------------------------------------------------------------------------------------
!close types, dataspaces
call h5tclose_f(dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f dtype_id')
call h5tclose_f(position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f position_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dclose_f')
call h5sclose_f(space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f space_id')
call h5sclose_f(memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f memspace')
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pclose_f')
call HDF5_closeGroup(mapping_ID)
enddo
end subroutine HDF5_backwardMappingPhase
!--------------------------------------------------------------------------------------------------
!> @brief adds the unique mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog)
use hdf5
implicit none
integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat
character(len=*), intent(in), dimension(:) :: homogenization_name
integer(pInt), intent(in), dimension(:) :: mpiOffset_homog
integer(pInt), intent(in) :: dataspace_size, mpiOffset
integer(pInt) :: hdferr, NmatPoints, i, j
integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace
integer(HID_T) :: dt5_id ! Memory datatype identifier
integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size
integer(HSIZE_T), dimension(1) :: counter
integer(HSSIZE_T), dimension(1) :: fileOffset
integer(pInt), dimension(:), allocatable :: arrOffset
NmatPoints = count(material_homog /=0_pInt)
mapping_ID = results_openGroup("current/mapGeometry")
allocate(arrOffset(NmatPoints))
do i=1_pInt, NmatPoints
do j=1_pInt, size(homogenization_name)
if(material_homog(1,i) == j) &
arrOffset(i) = mpiOffset_homog(j)
enddo
enddo
!--------------------------------------------------------------------------------------------------
! create dataspace
call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, &
int([dataspace_size],HSIZE_T))
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping')
!--------------------------------------------------------------------------------------------------
! compound type
! First calculate total size by calculating sizes of each member
!
CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr)
typesize = len(homogenization_name(1))
CALL h5tset_size_f(dt5_id, typesize, hdferr)
CALL h5tget_size_f(dt5_id, type_sizec, hdferr)
CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr)
type_size = type_sizec + type_sizei
call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id')
call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 0')
call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 2')
!--------------------------------------------------------------------------------------------------
! create Dataset
call h5dcreate_f(mapping_id, 'homogenization', dtype_id, space_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog')
!--------------------------------------------------------------------------------------------------
! Create memory types (one compound datatype for each member)
call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f instance_id')
call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f instance_id')
call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f position_id')
call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f position_id')
!--------------------------------------------------------------------------------------------------
! Define and select hyperslabs
counter = NmatPoints ! how big i am
fileOffset = mpiOffset ! where i start to write my data
call h5screate_simple_f(1, counter, memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5screate_simple_f')
call h5dget_space_f(dset_id, space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dget_space_f')
call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sselect_hyperslab_f')
!--------------------------------------------------------------------------------------------------
! Create property list for collective dataset write
#ifdef PETSc
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f')
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f')
#endif
!--------------------------------------------------------------------------------------------------
! write data by fields in the datatype. Fields order is not important.
call h5dwrite_f(dset_id, name_id, homogenization_name(pack(material_homog,material_homog/=0_pInt)), &
int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f position_id')
call h5dwrite_f(dset_id, position_id, pack(homogmemberat-1_pInt,homogmemberat/=0_pInt) + arrOffset, &
int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f instance_id')
!--------------------------------------------------------------------------------------------------
!close types, dataspaces
call h5tclose_f(dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dtype_id')
call h5tclose_f(position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f position_id')
call h5tclose_f(name_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f name_id ')
call h5tclose_f(dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dt5_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dclose_f')
call h5sclose_f(space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f space_id')
call h5sclose_f(memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f memspace')
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pclose_f')
call HDF5_closeGroup(mapping_ID)
end subroutine HDF5_mappingHomog
!--------------------------------------------------------------------------------------------------
!> @brief adds the backward mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog)
use hdf5
implicit none
integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat
character(len=*), intent(in), dimension(:) :: homogenization_name
integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_homog
integer(pInt), intent(in) :: mpiOffset
integer(pInt) :: hdferr, NmatPoints, i
integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace
integer(SIZE_T) :: type_size
integer(pInt), dimension(:,:), allocatable :: arr
integer(HSIZE_T), dimension(1) :: counter
integer(HSSIZE_T), dimension(1) :: fileOffset
character(len=64) :: homogID
NmatPoints = count(material_homog /=0_pInt)
allocate(arr(2,NmatPoints))
arr(1,:) = (/(i, i=0_pint,NmatPoints-1_pInt)/)
arr(2,:) = pack(material_homog,material_homog/=0_pInt)
do i=1_pInt, size(homogenization_name)
write(homogID, '(i0)') i
mapping_ID = results_openGroup('/current/homogenization/'//trim(homogID)//'_'//homogenization_name(i))
!--------------------------------------------------------------------------------------------------
! create dataspace
call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, &
int([dataspace_size(i)],HSIZE_T))
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping')
!--------------------------------------------------------------------------------------------------
! compound type
call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr)
call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id')
call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f 0')
!--------------------------------------------------------------------------------------------------
! create Dataset
call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog')
!--------------------------------------------------------------------------------------------------
! Create memory types (one compound datatype for each member)
call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tcreate_f position_id')
call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f position_id')
!--------------------------------------------------------------------------------------------------
! Define and select hyperslabs
counter = NmatPoints ! how big i am
fileOffset = mpiOffset_homog(i) ! where i start to write my data
call h5screate_simple_f(1, counter, memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5screate_simple_f')
call h5dget_space_f(dset_id, space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dget_space_f')
call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sselect_hyperslab_f')
!--------------------------------------------------------------------------------------------------
! Create property list for collective dataset write
#ifdef PETSc
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f')
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f')
#endif
!--------------------------------------------------------------------------------------------------
! write data by fields in the datatype. Fields order is not important.
call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset,int([dataspace_size(i)],HSIZE_T),&
hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dwrite_f instance_id')
!--------------------------------------------------------------------------------------------------
!close types, dataspaces
call h5tclose_f(dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f dtype_id')
call h5tclose_f(position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f position_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dclose_f')
call h5sclose_f(space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f space_id')
call h5sclose_f(memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f memspace')
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pclose_f')
call HDF5_closeGroup(mapping_ID)
enddo
end subroutine HDF5_backwardMappingHomog
!--------------------------------------------------------------------------------------------------
!> @brief adds the unique mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst)
use hdf5
implicit none
integer(pInt), intent(in), dimension(:,:) :: crystalliteAt
integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt
character(len=*), intent(in), dimension(:) :: crystallite_name
integer(pInt), intent(in), dimension(:) :: mpiOffset_cryst
integer(pInt), intent(in) :: dataspace_size, mpiOffset
integer :: hdferr
integer(pInt) :: NmatPoints, Nconstituents, i, j
integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, plist_id, memspace
integer(HID_T), dimension(:), allocatable :: position_id
integer(HID_T) :: dt5_id ! Memory datatype identifier
integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size
integer(HSIZE_T), dimension(1) :: counter
integer(HSSIZE_T), dimension(1) :: fileOffset
integer(pInt), dimension(:), allocatable :: arrOffset
character(len=64) :: m
Nconstituents = size(crystmemberAt,1)
NmatPoints = count(crystalliteAt /=0_pInt)
mapping_ID = results_openGroup("current/mapGeometry")
allocate(position_id(Nconstituents))
allocate(arrOffset(NmatPoints))
do i=1_pInt, NmatPoints
do j=1_pInt, size(crystallite_name)
if(crystalliteAt(1,i) == j) &
arrOffset(i) = Nconstituents*mpiOffset_cryst(j)
enddo
enddo
!--------------------------------------------------------------------------------------------------
! create dataspace
call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, &
int([dataspace_size],HSIZE_T))
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping')
!--------------------------------------------------------------------------------------------------
! compound type
! First calculate total size by calculating sizes of each member
!
CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr)
typesize = len(crystallite_name(1))
CALL h5tset_size_f(dt5_id, typesize, hdferr)
CALL h5tget_size_f(dt5_id, type_sizec, hdferr)
CALL h5tget_size_f(H5T_STD_I32LE, type_sizei, hdferr)
type_size = type_sizec + type_sizei*Nconstituents
call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id')
call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 0')
do i=1_pInt, Nconstituents
write(m, '(i0)') i
call h5tinsert_f(dtype_id, "Position "//trim(m), type_sizec+(i-1)*type_sizei, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 2 '//trim(m))
enddo
!--------------------------------------------------------------------------------------------------
! create Dataset
call h5dcreate_f(mapping_id, 'crystallite', dtype_id, space_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite')
!--------------------------------------------------------------------------------------------------
! Create memory types (one compound datatype for each member)
call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f instance_id')
call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f instance_id')
do i=1_pInt, Nconstituents
write(m, '(i0)') i
call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id(i), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f position_id')
call h5tinsert_f(position_id(i), "Position "//trim(m), 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f position_id')
enddo
!--------------------------------------------------------------------------------------------------
! Define and select hyperslabs
counter = NmatPoints ! how big i am
fileOffset = mpiOffset ! where i start to write my data
call h5screate_simple_f(1, counter, memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5screate_simple_f')
call h5dget_space_f(dset_id, space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dget_space_f')
call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sselect_hyperslab_f')
!--------------------------------------------------------------------------------------------------
! Create property list for collective dataset write
#ifdef PETSc
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f')
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f')
#endif
!--------------------------------------------------------------------------------------------------
! write data by fields in the datatype. Fields order is not important.
call h5dwrite_f(dset_id, name_id, crystallite_name(pack(crystalliteAt,crystalliteAt/=0_pInt)), &
int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f position_id')
do i=1_pInt, Nconstituents
call h5dwrite_f(dset_id, position_id(i), pack(crystmemberAt(i,:,:)-1_pInt,crystmemberAt(i,:,:)/=0_pInt)+arrOffset,&
int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f instance_id')
enddo
!--------------------------------------------------------------------------------------------------
!close types, dataspaces
call h5tclose_f(dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dtype_id')
do i=1_pInt, Nconstituents
call h5tclose_f(position_id(i), hdferr)
enddo
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f position_id')
call h5tclose_f(name_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f name_id')
call h5tclose_f(dt5_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dt5_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dclose_f')
call h5sclose_f(space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f space_id')
call h5sclose_f(memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f memspace')
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pclose_f')
call HDF5_closeGroup(mapping_ID)
end subroutine HDF5_mappingCrystallite
!--------------------------------------------------------------------------------------------------
!> @brief adds the backward mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst)
use hdf5
implicit none
integer(pInt), intent(in), dimension(:,:) :: crystalliteAt
integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt
character(len=*), intent(in), dimension(:) :: crystallite_name
integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_cryst
integer(pInt), intent(in) :: mpiOffset
integer :: hdferr
integer(pInt) :: NmatPoints, Nconstituents, i, j
integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace
integer(SIZE_T) :: type_size
integer(pInt), dimension(:,:), allocatable :: h_arr, arr
integer(HSIZE_T), dimension(1) :: counter
integer(HSSIZE_T), dimension(1) :: fileOffset
character(len=64) :: crystallID
Nconstituents = size(crystmemberAt,1)
NmatPoints = count(crystalliteAt /=0_pInt)
allocate(h_arr(2,NmatPoints))
allocate(arr(2,Nconstituents*NmatPoints))
h_arr(1,:) = (/(i, i=0_pInt,NmatPoints-1_pInt)/)
h_arr(2,:) = pack(crystalliteAt,crystalliteAt/=0_pInt)
do i=1_pInt, NmatPoints
do j=Nconstituents-1_pInt, 0_pInt, -1_pInt
arr(1,Nconstituents*i-j) = h_arr(1,i)
arr(2,Nconstituents*i-j) = h_arr(2,i)
enddo
enddo
do i=1_pInt, size(crystallite_name)
if (crystallite_name(i) == 'none') cycle
write(crystallID, '(i0)') i
mapping_ID = results_openGroup('/current/crystallite/'//trim(crystallID)//'_'//crystallite_name(i))
NmatPoints = count(crystalliteAt == i)
!--------------------------------------------------------------------------------------------------
! create dataspace
call h5screate_simple_f(1, int([Nconstituents*dataspace_size(i)],HSIZE_T), space_id, hdferr, &
int([Nconstituents*dataspace_size(i)],HSIZE_T))
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping')
!--------------------------------------------------------------------------------------------------
! compound type
call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr)
call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id')
call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f 0')
!--------------------------------------------------------------------------------------------------
! create Dataset
call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite')
!--------------------------------------------------------------------------------------------------
! Create memory types
call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tcreate_f position_id')
call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f position_id')
!--------------------------------------------------------------------------------------------------
! Define and select hyperslabs
counter = Nconstituents*NmatPoints ! how big i am
fileOffset = Nconstituents*mpiOffset_cryst(i) ! where i start to write my data
call h5screate_simple_f(1, counter, memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5screate_simple_f')
call h5dget_space_f(dset_id, space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dget_space_f')
call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sselect_hyperslab_f')
!--------------------------------------------------------------------------------------------------
! Create property list for collective dataset write
#ifdef PETSc
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f')
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f')
#endif
!--------------------------------------------------------------------------------------------------
! write data by fields in the datatype. Fields order is not important.
call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i) + mpiOffset,&
int([Nconstituents*dataspace_size(i)],HSIZE_T), hdferr, file_space_id = space_id, &
mem_space_id = memspace, xfer_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dwrite_f instance_id')
!--------------------------------------------------------------------------------------------------
!close types, dataspaces
call h5tclose_f(dtype_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f dtype_id')
call h5tclose_f(position_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f position_id')
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dclose_f')
call h5sclose_f(space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f space_id')
call h5sclose_f(memspace, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f memspace')
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pclose_f')
call HDF5_closeGroup(mapping_ID)
enddo
end subroutine HDF5_backwardMappingCrystallite
!--------------------------------------------------------------------------------------------------
!> @brief adds the unique cell to node mapping
!--------------------------------------------------------------------------------------------------
subroutine HDF5_mappingCells(mapping)
use hdf5
implicit none
integer(pInt), intent(in), dimension(:) :: mapping
integer :: hdferr, Nnodes
integer(HID_T) :: mapping_id, dset_id, space_id
Nnodes=size(mapping)
mapping_ID = results_openGroup("mapping")
!--------------------------------------------------------------------------------------------------
! create dataspace
call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, &
int([Nnodes],HSIZE_T))
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5screate_simple_f')
!--------------------------------------------------------------------------------------------------
! create Dataset
call h5dcreate_f(mapping_id, "Cell",H5T_NATIVE_INTEGER, space_id, dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells')
!--------------------------------------------------------------------------------------------------
! write data by fields in the datatype. Fields order is not important.
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, mapping, int([Nnodes],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5dwrite_f instance_id')
!--------------------------------------------------------------------------------------------------
!close types, dataspaces
call h5dclose_f(dset_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dclose_f')
call h5sclose_f(space_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5sclose_f')
call HDF5_closeGroup(mapping_ID)
end subroutine HDF5_mappingCells
end module results

15
src/source_damage_isoBrittle.f90
View File

@ -262,10 +262,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
sourceState, &
material_homog, &
phase_NstiffnessDegradations, &
phase_stiffnessDegradation, &
porosity, &
porosityMapping, &
STIFFNESS_DEGRADATION_porosity_ID
phase_stiffnessDegradation
use math, only : &
math_mul33x33, &
math_mul66x6, &
@ -295,15 +292,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source
sourceOffset = source_damage_isoBrittle_offset(phase)
stiffness = C
do mech = 1_pInt, phase_NstiffnessDegradations(phase)
select case(phase_stiffnessDegradation(mech,phase))
case (STIFFNESS_DEGRADATION_porosity_ID)
stiffness = porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* &
porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* &
stiffness
end select
enddo
stiffness = C
strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3)
strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ &

248
src/source_vacancy_irradiation.f90
View File

@ -1,248 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for vacancy generation due to irradiation
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_vacancy_irradiation
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_vacancy_irradiation_sizePostResults, & !< cumulative size of post results
source_vacancy_irradiation_offset, & !< which source is my current damage mechanism?
source_vacancy_irradiation_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_vacancy_irradiation_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_vacancy_irradiation_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_vacancy_irradiation_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_vacancy_irradiation_cascadeProb, &
source_vacancy_irradiation_cascadeVolume
public :: &
source_vacancy_irradiation_init, &
source_vacancy_irradiation_deltaState, &
source_vacancy_irradiation_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_irradiation_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_vacancy_irradiation_label, &
SOURCE_vacancy_irradiation_ID, &
material_phase, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_irradiation_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_source == SOURCE_vacancy_irradiation_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_vacancy_irradiation_offset(material_Nphase), source=0_pInt)
allocate(source_vacancy_irradiation_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_vacancy_irradiation_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_irradiation_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_vacancy_irradiation_ID) &
source_vacancy_irradiation_offset(phase) = source
enddo
enddo
allocate(source_vacancy_irradiation_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_vacancy_irradiation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_vacancy_irradiation_output(maxval(phase_Noutput),maxNinstance))
source_vacancy_irradiation_output = ''
allocate(source_vacancy_irradiation_Noutput(maxNinstance), source=0_pInt)
allocate(source_vacancy_irradiation_cascadeProb(maxNinstance), source=0.0_pReal)
allocate(source_vacancy_irradiation_cascadeVolume(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = source_vacancy_irradiation_instance(phase) ! which instance of my vacancy is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('irradiation_cascadeprobability')
source_vacancy_irradiation_cascadeProb(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('irradiation_cascadevolume')
source_vacancy_irradiation_cascadeVolume(instance) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif; endif
enddo parsingFile
initializeInstances: do phase = 1_pInt, material_Nphase
if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then
NofMyPhase=count(material_phase==phase)
instance = source_vacancy_irradiation_instance(phase)
sourceOffset = source_vacancy_irradiation_offset(phase)
sizeDotState = 2_pInt
sizeDeltaState = 2_pInt
sizeState = 2_pInt
sourceState(phase)%p(sourceOffset)%sizeState = sizeState
sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState
sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState
sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_irradiation_sizePostResults(instance)
allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.1_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
endif
enddo initializeInstances
end subroutine source_vacancy_irradiation_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_irradiation_deltaState(ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
integer(pInt) :: &
phase, constituent, sourceOffset
real(pReal) :: &
randNo
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
sourceOffset = source_vacancy_irradiation_offset(phase)
call random_number(randNo)
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
randNo - sourceState(phase)%p(sourceOffset)%state(1,constituent)
call random_number(randNo)
sourceState(phase)%p(sourceOffset)%deltaState(2,constituent) = &
randNo - sourceState(phase)%p(sourceOffset)%state(2,constituent)
end subroutine source_vacancy_irradiation_deltaState
!--------------------------------------------------------------------------------------------------
!> @brief returns local vacancy generation rate
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_irradiation_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(out) :: &
CvDot, dCvDot_dCv
integer(pInt) :: &
instance, phase, constituent, sourceOffset
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_vacancy_irradiation_instance(phase)
sourceOffset = source_vacancy_irradiation_offset(phase)
CvDot = 0.0_pReal
dCvDot_dCv = 0.0_pReal
if (sourceState(phase)%p(sourceOffset)%state0(1,constituent) < source_vacancy_irradiation_cascadeProb(instance)) &
CvDot = sourceState(phase)%p(sourceOffset)%state0(2,constituent)*source_vacancy_irradiation_cascadeVolume(instance)
end subroutine source_vacancy_irradiation_getRateAndItsTangent
end module source_vacancy_irradiation

210
src/source_vacancy_phenoplasticity.f90
View File

@ -1,210 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for vacancy generation due to plasticity
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_vacancy_phenoplasticity
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_vacancy_phenoplasticity_sizePostResults, & !< cumulative size of post results
source_vacancy_phenoplasticity_offset, & !< which source is my current damage mechanism?
source_vacancy_phenoplasticity_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_vacancy_phenoplasticity_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_vacancy_phenoplasticity_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_vacancy_phenoplasticity_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_vacancy_phenoplasticity_rateCoeff
public :: &
source_vacancy_phenoplasticity_init, &
source_vacancy_phenoplasticity_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_phenoplasticity_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_vacancy_phenoplasticity_label, &
SOURCE_vacancy_phenoplasticity_ID, &
material_phase, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_phenoplasticity_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_source == SOURCE_vacancy_phenoplasticity_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_vacancy_phenoplasticity_offset(material_Nphase), source=0_pInt)
allocate(source_vacancy_phenoplasticity_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_vacancy_phenoplasticity_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_phenoplasticity_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_vacancy_phenoplasticity_ID) &
source_vacancy_phenoplasticity_offset(phase) = source
enddo
enddo
allocate(source_vacancy_phenoplasticity_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_vacancy_phenoplasticity_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_vacancy_phenoplasticity_output(maxval(phase_Noutput),maxNinstance))
source_vacancy_phenoplasticity_output = ''
allocate(source_vacancy_phenoplasticity_Noutput(maxNinstance), source=0_pInt)
allocate(source_vacancy_phenoplasticity_rateCoeff(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = source_vacancy_phenoplasticity_instance(phase) ! which instance of my vacancy is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('phenoplasticity_ratecoeff')
source_vacancy_phenoplasticity_rateCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif; endif
enddo parsingFile
initializeInstances: do phase = 1_pInt, material_Nphase
if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then
NofMyPhase=count(material_phase==phase)
instance = source_vacancy_phenoplasticity_instance(phase)
sourceOffset = source_vacancy_phenoplasticity_offset(phase)
sizeDotState = 0_pInt
sizeDeltaState = 0_pInt
sizeState = 0_pInt
sourceState(phase)%p(sourceOffset)%sizeState = sizeState
sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState
sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState
sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_phenoplasticity_sizePostResults(instance)
allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
endif
enddo initializeInstances
end subroutine source_vacancy_phenoplasticity_init
!--------------------------------------------------------------------------------------------------
!> @brief returns local vacancy generation rate
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_phenoplasticity_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
plasticState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(out) :: &
CvDot, dCvDot_dCv
integer(pInt) :: &
instance, phase, constituent
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_vacancy_phenoplasticity_instance(phase)
CvDot = &
source_vacancy_phenoplasticity_rateCoeff(instance)* &
sum(plasticState(phase)%slipRate(:,constituent))
dCvDot_dCv = 0.0_pReal
end subroutine source_vacancy_phenoplasticity_getRateAndItsTangent
end module source_vacancy_phenoplasticity

250
src/source_vacancy_thermalfluc.f90
View File

@ -1,250 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for vacancy generation due to thermal fluctuations
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_vacancy_thermalfluc
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_vacancy_thermalfluc_sizePostResults, & !< cumulative size of post results
source_vacancy_thermalfluc_offset, & !< which source is my current damage mechanism?
source_vacancy_thermalfluc_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
source_vacancy_thermalfluc_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_vacancy_thermalfluc_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_vacancy_thermalfluc_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_vacancy_thermalfluc_amplitude, &
source_vacancy_thermalfluc_normVacancyEnergy
public :: &
source_vacancy_thermalfluc_init, &
source_vacancy_thermalfluc_deltaState, &
source_vacancy_thermalfluc_getRateAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_thermalfluc_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use lattice, only: &
lattice_vacancyFormationEnergy
use material, only: &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_vacancy_thermalfluc_label, &
SOURCE_vacancy_thermalfluc_ID, &
material_phase, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_thermalfluc_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_source == SOURCE_vacancy_thermalfluc_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(source_vacancy_thermalfluc_offset(material_Nphase), source=0_pInt)
allocate(source_vacancy_thermalfluc_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
source_vacancy_thermalfluc_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_thermalfluc_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_vacancy_thermalfluc_ID) &
source_vacancy_thermalfluc_offset(phase) = source
enddo
enddo
allocate(source_vacancy_thermalfluc_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_vacancy_thermalfluc_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_vacancy_thermalfluc_output(maxval(phase_Noutput),maxNinstance))
source_vacancy_thermalfluc_output = ''
allocate(source_vacancy_thermalfluc_Noutput(maxNinstance), source=0_pInt)
allocate(source_vacancy_thermalfluc_amplitude(maxNinstance), source=0.0_pReal)
allocate(source_vacancy_thermalfluc_normVacancyEnergy(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = source_vacancy_thermalfluc_instance(phase) ! which instance of my vacancy is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('thermalfluctuation_amplitude')
source_vacancy_thermalfluc_amplitude(instance) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif; endif
enddo parsingFile
initializeInstances: do phase = 1_pInt, material_Nphase
if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then
NofMyPhase=count(material_phase==phase)
instance = source_vacancy_thermalfluc_instance(phase)
source_vacancy_thermalfluc_normVacancyEnergy(instance) = &
lattice_vacancyFormationEnergy(phase)/1.3806488e-23_pReal
sourceOffset = source_vacancy_thermalfluc_offset(phase)
sizeDotState = 1_pInt
sizeDeltaState = 1_pInt
sizeState = 1_pInt
sourceState(phase)%p(sourceOffset)%sizeState = sizeState
sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState
sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState
sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_thermalfluc_sizePostResults(instance)
allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.1_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
endif
enddo initializeInstances
end subroutine source_vacancy_thermalfluc_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_thermalfluc_deltaState(ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
integer(pInt) :: &
phase, constituent, sourceOffset
real(pReal) :: &
randNo
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
sourceOffset = source_vacancy_thermalfluc_offset(phase)
call random_number(randNo)
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
randNo - 0.5_pReal - sourceState(phase)%p(sourceOffset)%state(1,constituent)
end subroutine source_vacancy_thermalfluc_deltaState
!--------------------------------------------------------------------------------------------------
!> @brief returns local vacancy generation rate
!--------------------------------------------------------------------------------------------------
subroutine source_vacancy_thermalfluc_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
material_homog, &
temperature, &
thermalMapping, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(out) :: &
CvDot, dCvDot_dCv
integer(pInt) :: &
instance, phase, constituent, sourceOffset
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_vacancy_thermalfluc_instance(phase)
sourceOffset = source_vacancy_thermalfluc_offset(phase)
CvDot = source_vacancy_thermalfluc_amplitude(instance)* &
sourceState(phase)%p(sourceOffset)%state0(2,constituent)* &
exp(-source_vacancy_thermalfluc_normVacancyEnergy(instance)/ &
temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el)))
dCvDot_dCv = 0.0_pReal
end subroutine source_vacancy_thermalfluc_getRateAndItsTangent
end module source_vacancy_thermalfluc

5
src/spectral_mech_Basic.f90
View File

@ -80,6 +80,7 @@ subroutine basic_init
#endif
use IO, only: &
IO_intOut, &
IO_error, &
IO_read_realFile, &
IO_timeStamp
use debug, only: &
@ -173,7 +174,11 @@ subroutine basic_init
call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot))
read (777,rec=1) F_aimDot; close (777)
F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F
call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim')
F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc
call MPI_Allreduce(MPI_IN_PLACE,F_aim_lastInc,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim_lastInc')
elseif (restartInc == 0_pInt) then restart
F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity
F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])

6
src/spectral_mech_Polarisation.f90
View File

@ -78,7 +78,6 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc)
!--------------------------------------------------------------------------------------------------
subroutine Polarisation_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
@ -88,6 +87,7 @@ subroutine Polarisation_init
#endif
use IO, only: &
IO_intOut, &
IO_error, &
IO_read_realFile, &
IO_timeStamp
use debug, only: &
@ -191,7 +191,11 @@ subroutine Polarisation_init
call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot))
read (777,rec=1) F_aimDot; close (777)
F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F
call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim')
F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc
call MPI_Allreduce(MPI_IN_PLACE,F_aim_lastInc,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim_lastInc')
elseif (restartInc == 0_pInt) then restart
F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity
F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])

148
src/system_routines.f90
View File

@ -3,11 +3,17 @@
!> @brief provides wrappers to C routines
!--------------------------------------------------------------------------------------------------
module system_routines
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
private
public :: &
signalusr1_C, &
signalusr2_C, &
isDirectory, &
getCWD, &
getHostName, &
@ -27,7 +33,7 @@ interface
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
integer(C_INT),intent(out) :: stat
end subroutine getCurrentWorkDir_C
@ -35,7 +41,7 @@ interface
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
integer(C_INT),intent(out) :: stat
end subroutine getHostName_C
@ -46,31 +52,38 @@ interface
integer(C_INT) :: chdir_C
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array
end function chdir_C
subroutine signalusr1_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr1_C
subroutine signalusr2_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr2_C
end interface
contains
!--------------------------------------------------------------------------------------------------
!> @brief figures out if a given path is a directory (and not an ordinary file)
!--------------------------------------------------------------------------------------------------
logical function isDirectory(path)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength
integer :: i
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string as array
integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
end function isDirectory
@ -79,29 +92,25 @@ end function isDirectory
!> @brief gets the current working directory
!--------------------------------------------------------------------------------------------------
character(len=1024) function getCWD()
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
call getCurrentWorkDir_C(charArray,stat)
if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory'
else
getCWD = repeat('',len(getCWD))
arrayToString: do i=1,len(getCWD)
if (charArray(i) /= C_NULL_CHAR) then
getCWD(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
call getCurrentWorkDir_C(charArray,stat)
if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory'
else
getCWD = repeat('',len(getCWD))
arrayToString: do i=1,len(getCWD)
if (charArray(i) /= C_NULL_CHAR) then
getCWD(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
end function getCWD
@ -110,51 +119,42 @@ end function getCWD
!> @brief gets the current host name
!--------------------------------------------------------------------------------------------------
character(len=1024) function getHostName()
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
call getHostName_C(charArray,stat)
if (stat /= 0_C_INT) then
getHostName = 'Error occured when getting host name'
else
getHostName = repeat('',len(getHostName))
arrayToString: do i=1,len(getHostName)
if (charArray(i) /= C_NULL_CHAR) then
getHostName(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
call getHostName_C(charArray,stat)
if (stat /= 0_C_INT) then
getHostName = 'Error occured when getting host name'
else
getHostName = repeat('',len(getHostName))
arrayToString: do i=1,len(getHostName)
if (charArray(i) /= C_NULL_CHAR) then
getHostName(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
end function getHostName
!--------------------------------------------------------------------------------------------------
!> @brief changes the current working directory
!--------------------------------------------------------------------------------------------------
logical function setCWD(path)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer :: i
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
end function setCWD

602
src/vacancyflux_cahnhilliard.f90
View File

@ -1,602 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for conservative transport of vacancy concentration field
!> @details to be done
!--------------------------------------------------------------------------------------------------
module vacancyflux_cahnhilliard
use prec, only: &
pReal, &
pInt, &
group_float
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
vacancyflux_cahnhilliard_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
vacancyflux_cahnhilliard_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
vacancyflux_cahnhilliard_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
vacancyflux_cahnhilliard_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
vacancyflux_cahnhilliard_flucAmplitude
type(group_float), dimension(:), allocatable, private :: &
vacancyflux_cahnhilliard_thermalFluc
real(pReal), parameter, private :: &
kB = 1.3806488e-23_pReal !< Boltzmann constant in J/Kelvin
enum, bind(c)
enumerator :: undefined_ID, &
vacancyConc_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
vacancyflux_cahnhilliard_outputID !< ID of each post result output
public :: &
vacancyflux_cahnhilliard_init, &
vacancyflux_cahnhilliard_getSourceAndItsTangent, &
vacancyflux_cahnhilliard_getMobility33, &
vacancyflux_cahnhilliard_getDiffusion33, &
vacancyflux_cahnhilliard_getChemPotAndItsTangent, &
vacancyflux_cahnhilliard_putVacancyConcAndItsRate, &
vacancyflux_cahnhilliard_postResults
private :: &
vacancyflux_cahnhilliard_getFormationEnergy, &
vacancyflux_cahnhilliard_getEntropicCoeff, &
vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_cahnhilliard_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
vacancyflux_type, &
vacancyflux_typeInstance, &
homogenization_Noutput, &
VACANCYFLUX_cahnhilliard_label, &
VACANCYFLUX_cahnhilliard_ID, &
material_homog, &
mappingHomogenization, &
vacancyfluxState, &
vacancyfluxMapping, &
vacancyConc, &
vacancyConcRate, &
vacancyflux_initialCv
use config, only: &
material_partPhase, &
material_partHomogenization
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,offset
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_cahnhilliard_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(vacancyflux_cahnhilliard_sizePostResults(maxNinstance), source=0_pInt)
allocate(vacancyflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(vacancyflux_cahnhilliard_output (maxval(homogenization_Noutput),maxNinstance))
vacancyflux_cahnhilliard_output = ''
allocate(vacancyflux_cahnhilliard_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(vacancyflux_cahnhilliard_Noutput (maxNinstance), source=0_pInt)
allocate(vacancyflux_cahnhilliard_flucAmplitude (maxNinstance))
allocate(vacancyflux_cahnhilliard_thermalFluc (maxNinstance))
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next homog section
section = section + 1_pInt ! advance homog section counter
cycle ! skip to next line
endif
if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux is present homog
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('vacancyconc')
vacancyflux_cahnhilliard_Noutput(instance) = vacancyflux_cahnhilliard_Noutput(instance) + 1_pInt
vacancyflux_cahnhilliard_outputID(vacancyflux_cahnhilliard_Noutput(instance),instance) = vacancyConc_ID
vacancyflux_cahnhilliard_output(vacancyflux_cahnhilliard_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
case ('vacancyflux_flucamplitude')
vacancyflux_cahnhilliard_flucAmplitude(instance) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif; endif
enddo parsingHomog
initializeInstances: do section = 1_pInt, size(vacancyflux_type)
if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then
NofMyHomog=count(material_homog==section)
instance = vacancyflux_typeInstance(section)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance)
select case(vacancyflux_cahnhilliard_outputID(o,instance))
case(vacancyConc_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
vacancyflux_cahnhilliard_sizePostResult(o,instance) = mySize
vacancyflux_cahnhilliard_sizePostResults(instance) = vacancyflux_cahnhilliard_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! allocate state arrays
sizeState = 0_pInt
vacancyfluxState(section)%sizeState = sizeState
vacancyfluxState(section)%sizePostResults = vacancyflux_cahnhilliard_sizePostResults(instance)
allocate(vacancyfluxState(section)%state0 (sizeState,NofMyHomog))
allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog))
allocate(vacancyfluxState(section)%state (sizeState,NofMyHomog))
allocate(vacancyflux_cahnhilliard_thermalFluc(instance)%p(NofMyHomog))
do offset = 1_pInt, NofMyHomog
call random_number(vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset))
vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) = &
1.0_pReal - &
vacancyflux_cahnhilliard_flucAmplitude(instance)* &
(vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) - 0.5_pReal)
enddo
nullify(vacancyfluxMapping(section)%p)
vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:)
deallocate(vacancyConc (section)%p)
allocate (vacancyConc (section)%p(NofMyHomog), source=vacancyflux_initialCv(section))
deallocate(vacancyConcRate(section)%p)
allocate (vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal)
endif
enddo initializeInstances
end subroutine vacancyflux_cahnhilliard_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates homogenized vacancy driving forces
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el)
use material, only: &
homogenization_Ngrains, &
mappingHomogenization, &
phaseAt, &
phase_source, &
phase_Nsources, &
SOURCE_vacancy_phenoplasticity_ID, &
SOURCE_vacancy_irradiation_ID, &
SOURCE_vacancy_thermalfluc_ID
use source_vacancy_phenoplasticity, only: &
source_vacancy_phenoplasticity_getRateAndItsTangent
use source_vacancy_irradiation, only: &
source_vacancy_irradiation_getRateAndItsTangent
use source_vacancy_thermalfluc, only: &
source_vacancy_thermalfluc_getRateAndItsTangent
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Cv
integer(pInt) :: &
phase, &
grain, &
source
real(pReal) :: &
CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv
CvDot = 0.0_pReal
dCvDot_dCv = 0.0_pReal
do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
phase = phaseAt(grain,ip,el)
do source = 1_pInt, phase_Nsources(phase)
select case(phase_source(source,phase))
case (SOURCE_vacancy_phenoplasticity_ID)
call source_vacancy_phenoplasticity_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el)
case (SOURCE_vacancy_irradiation_ID)
call source_vacancy_irradiation_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el)
case (SOURCE_vacancy_thermalfluc_ID)
call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip, el)
end select
CvDot = CvDot + localCvDot
dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv
enddo
enddo
CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
end subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized vacancy mobility tensor in reference configuration
!--------------------------------------------------------------------------------------------------
function vacancyflux_cahnhilliard_getMobility33(ip,el)
use lattice, only: &
lattice_vacancyfluxMobility33
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
use crystallite, only: &
crystallite_push33ToRef
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
vacancyflux_cahnhilliard_getMobility33
integer(pInt) :: &
grain
vacancyflux_cahnhilliard_getMobility33 = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
vacancyflux_cahnhilliard_getMobility33 = vacancyflux_cahnhilliard_getMobility33 + &
crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxMobility33(:,:,material_phase(grain,ip,el)))
enddo
vacancyflux_cahnhilliard_getMobility33 = &
vacancyflux_cahnhilliard_getMobility33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function vacancyflux_cahnhilliard_getMobility33
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized vacancy diffusion tensor in reference configuration
!--------------------------------------------------------------------------------------------------
function vacancyflux_cahnhilliard_getDiffusion33(ip,el)
use lattice, only: &
lattice_vacancyfluxDiffusion33
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
use crystallite, only: &
crystallite_push33ToRef
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
vacancyflux_cahnhilliard_getDiffusion33
integer(pInt) :: &
grain
vacancyflux_cahnhilliard_getDiffusion33 = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
vacancyflux_cahnhilliard_getDiffusion33 = vacancyflux_cahnhilliard_getDiffusion33 + &
crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxDiffusion33(:,:,material_phase(grain,ip,el)))
enddo
vacancyflux_cahnhilliard_getDiffusion33 = &
vacancyflux_cahnhilliard_getDiffusion33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function vacancyflux_cahnhilliard_getDiffusion33
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized vacancy formation energy
!--------------------------------------------------------------------------------------------------
real(pReal) function vacancyflux_cahnhilliard_getFormationEnergy(ip,el)
use lattice, only: &
lattice_vacancyFormationEnergy, &
lattice_vacancyVol, &
lattice_vacancySurfaceEnergy
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
integer(pInt) :: &
grain
vacancyflux_cahnhilliard_getFormationEnergy = 0.0_pReal
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
vacancyflux_cahnhilliard_getFormationEnergy = vacancyflux_cahnhilliard_getFormationEnergy + &
lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ &
lattice_vacancyVol(material_phase(grain,ip,el))/ &
lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
enddo
vacancyflux_cahnhilliard_getFormationEnergy = &
vacancyflux_cahnhilliard_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
end function vacancyflux_cahnhilliard_getFormationEnergy
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized vacancy entropy coefficient
!--------------------------------------------------------------------------------------------------
real(pReal) function vacancyflux_cahnhilliard_getEntropicCoeff(ip,el)
use lattice, only: &
lattice_vacancyVol, &
lattice_vacancySurfaceEnergy
use material, only: &
homogenization_Ngrains, &
material_homog, &
material_phase, &
temperature, &
thermalMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
integer(pInt) :: &
grain
vacancyflux_cahnhilliard_getEntropicCoeff = 0.0_pReal
do grain = 1, homogenization_Ngrains(material_homog(ip,el))
vacancyflux_cahnhilliard_getEntropicCoeff = vacancyflux_cahnhilliard_getEntropicCoeff + &
kB/ &
lattice_vacancyVol(material_phase(grain,ip,el))/ &
lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
enddo
vacancyflux_cahnhilliard_getEntropicCoeff = &
vacancyflux_cahnhilliard_getEntropicCoeff* &
temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ &
real(homogenization_Ngrains(material_homog(ip,el)),pReal)
end function vacancyflux_cahnhilliard_getEntropicCoeff
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized kinematic contribution to chemical potential
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el)
use lattice, only: &
lattice_vacancySurfaceEnergy
use material, only: &
homogenization_Ngrains, &
material_homog, &
phase_kinematics, &
phase_Nkinematics, &
material_phase, &
KINEMATICS_vacancy_strain_ID
use crystallite, only: &
crystallite_Tstar_v, &
crystallite_Fi0, &
crystallite_Fi
use kinematics_vacancy_strain, only: &
kinematics_vacancy_strain_ChemPotAndItsTangent
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Cv
real(pReal), intent(out) :: &
KPot, dKPot_dCv
real(pReal) :: &
my_KPot, my_dKPot_dCv
integer(pInt) :: &
grain, kinematics
KPot = 0.0_pReal
dKPot_dCv = 0.0_pReal
do grain = 1_pInt,homogenization_Ngrains(material_homog(ip,el))
do kinematics = 1_pInt, phase_Nkinematics(material_phase(grain,ip,el))
select case (phase_kinematics(kinematics,material_phase(grain,ip,el)))
case (KINEMATICS_vacancy_strain_ID)
call kinematics_vacancy_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCv, &
crystallite_Tstar_v(1:6,grain,ip,el), &
crystallite_Fi0(1:3,1:3,grain,ip,el), &
crystallite_Fi (1:3,1:3,grain,ip,el), &
grain,ip, el)
case default
my_KPot = 0.0_pReal
my_dKPot_dCv = 0.0_pReal
end select
KPot = KPot + my_KPot/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
dKPot_dCv = dKPot_dCv + my_dKPot_dCv/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
enddo
enddo
KPot = KPot/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
dKPot_dCv = dKPot_dCv/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
end subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized chemical potential and its tangent
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCv,Cv,ip,el)
use numerics, only: &
vacancyBoundPenalty, &
vacancyPolyOrder
use material, only: &
mappingHomogenization, &
vacancyflux_typeInstance, &
porosity, &
porosityMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Cv
real(pReal), intent(out) :: &
ChemPot, &
dChemPot_dCv
real(pReal) :: &
VoidPhaseFrac, kBT, KPot, dKPot_dCv
integer(pInt) :: &
homog, o
homog = mappingHomogenization(2,ip,el)
VoidPhaseFrac = porosity(homog)%p(porosityMapping(homog)%p(ip,el))
kBT = vacancyflux_cahnhilliard_getEntropicCoeff(ip,el)
ChemPot = vacancyflux_cahnhilliard_getFormationEnergy(ip,el)
dChemPot_dCv = 0.0_pReal
do o = 1_pInt, vacancyPolyOrder
ChemPot = ChemPot + kBT*((2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ &
real(2_pInt*o-1_pInt,pReal)
dChemPot_dCv = dChemPot_dCv + 2.0_pReal*kBT*(2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal)
enddo
ChemPot = VoidPhaseFrac*VoidPhaseFrac*ChemPot &
- 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac)
dChemPot_dCv = VoidPhaseFrac*VoidPhaseFrac*dChemPot_dCv &
+ 2.0_pReal*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac)
call vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el)
ChemPot = ChemPot + KPot
dChemPot_dCv = dChemPot_dCv + dKPot_dCv
if (Cv < 0.0_pReal) then
ChemPot = ChemPot - 3.0_pReal*vacancyBoundPenalty*Cv*Cv
dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*Cv
elseif (Cv > 1.0_pReal) then
ChemPot = ChemPot + 3.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv)*(1.0_pReal - Cv)
dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv)
endif
ChemPot = ChemPot* &
vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el))
dChemPot_dCv = dChemPot_dCv* &
vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el))
end subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief updated vacancy concentration and its rate with solution from transport PDE
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate(Cv,Cvdot,ip,el)
use material, only: &
mappingHomogenization, &
vacancyConc, &
vacancyConcRate, &
vacancyfluxMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Cv, &
Cvdot
integer(pInt) :: &
homog, &
offset
homog = mappingHomogenization(2,ip,el)
offset = vacancyfluxMapping(homog)%p(ip,el)
vacancyConc (homog)%p(offset) = Cv
vacancyConcRate(homog)%p(offset) = Cvdot
end subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate
!--------------------------------------------------------------------------------------------------
!> @brief return array of vacancy transport results
!--------------------------------------------------------------------------------------------------
function vacancyflux_cahnhilliard_postResults(ip,el)
use material, only: &
mappingHomogenization, &
vacancyflux_typeInstance, &
vacancyConc, &
vacancyfluxMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(vacancyflux_cahnhilliard_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: &
vacancyflux_cahnhilliard_postResults
integer(pInt) :: &
instance, homog, offset, o, c
homog = mappingHomogenization(2,ip,el)
offset = vacancyfluxMapping(homog)%p(ip,el)
instance = vacancyflux_typeInstance(homog)
c = 0_pInt
vacancyflux_cahnhilliard_postResults = 0.0_pReal
do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance)
select case(vacancyflux_cahnhilliard_outputID(o,instance))
case (vacancyConc_ID)
vacancyflux_cahnhilliard_postResults(c+1_pInt) = vacancyConc(homog)%p(offset)
c = c + 1
end select
enddo
end function vacancyflux_cahnhilliard_postResults
end module vacancyflux_cahnhilliard

328
src/vacancyflux_isochempot.f90
View File

@ -1,328 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for locally evolving vacancy concentration
!> @details to be done
!--------------------------------------------------------------------------------------------------
module vacancyflux_isochempot
use prec, only: &
pReal, &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
vacancyflux_isochempot_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
vacancyflux_isochempot_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
vacancyflux_isochempot_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
vacancyflux_isochempot_Noutput !< number of outputs per instance of this damage
enum, bind(c)
enumerator :: undefined_ID, &
vacancyconc_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
vacancyflux_isochempot_outputID !< ID of each post result output
public :: &
vacancyflux_isochempot_init, &
vacancyflux_isochempot_updateState, &
vacancyflux_isochempot_getSourceAndItsTangent, &
vacancyflux_isochempot_postResults
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_isochempot_init(fileUnit)
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
vacancyflux_type, &
vacancyflux_typeInstance, &
homogenization_Noutput, &
VACANCYFLUX_isochempot_label, &
VACANCYFLUX_isochempot_ID, &
material_homog, &
mappingHomogenization, &
vacancyfluxState, &
vacancyfluxMapping, &
vacancyConc, &
vacancyConcRate, &
vacancyflux_initialCv
use config, only: &
material_partHomogenization
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isochempot_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_isochempot_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(vacancyflux_isochempot_sizePostResults(maxNinstance), source=0_pInt)
allocate(vacancyflux_isochempot_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(vacancyflux_isochempot_output (maxval(homogenization_Noutput),maxNinstance))
vacancyflux_isochempot_output = ''
allocate(vacancyflux_isochempot_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(vacancyflux_isochempot_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next homog section
section = section + 1_pInt ! advance homog section counter
cycle ! skip to next line
endif
if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux is present homog
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('vacancyconc')
vacancyflux_isochempot_Noutput(instance) = vacancyflux_isochempot_Noutput(instance) + 1_pInt
vacancyflux_isochempot_outputID(vacancyflux_isochempot_Noutput(instance),instance) = vacancyconc_ID
vacancyflux_isochempot_output(vacancyflux_isochempot_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
end select
endif; endif
enddo parsingFile
initializeInstances: do section = 1_pInt, size(vacancyflux_type)
if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then
NofMyHomog=count(material_homog==section)
instance = vacancyflux_typeInstance(section)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,vacancyflux_isochempot_Noutput(instance)
select case(vacancyflux_isochempot_outputID(o,instance))
case(vacancyconc_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
vacancyflux_isochempot_sizePostResult(o,instance) = mySize
vacancyflux_isochempot_sizePostResults(instance) = vacancyflux_isochempot_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! allocate state arrays
sizeState = 1_pInt
vacancyfluxState(section)%sizeState = sizeState
vacancyfluxState(section)%sizePostResults = vacancyflux_isochempot_sizePostResults(instance)
allocate(vacancyfluxState(section)%state0 (sizeState,NofMyHomog), source=vacancyflux_initialCv(section))
allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog), source=vacancyflux_initialCv(section))
allocate(vacancyfluxState(section)%state (sizeState,NofMyHomog), source=vacancyflux_initialCv(section))
nullify(vacancyfluxMapping(section)%p)
vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:)
deallocate(vacancyConc(section)%p)
vacancyConc(section)%p => vacancyfluxState(section)%state(1,:)
deallocate(vacancyConcRate(section)%p)
allocate(vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal)
endif
enddo initializeInstances
end subroutine vacancyflux_isochempot_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates change in vacancy concentration based on local vacancy generation model
!--------------------------------------------------------------------------------------------------
function vacancyflux_isochempot_updateState(subdt, ip, el)
use numerics, only: &
err_vacancyflux_tolAbs, &
err_vacancyflux_tolRel
use material, only: &
mappingHomogenization, &
vacancyflux_typeInstance, &
vacancyfluxState, &
vacancyConc, &
vacancyConcRate, &
vacancyfluxMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
subdt
logical, dimension(2) :: &
vacancyflux_isochempot_updateState
integer(pInt) :: &
homog, &
offset, &
instance
real(pReal) :: &
Cv, Cvdot, dCvDot_dCv
homog = mappingHomogenization(2,ip,el)
offset = mappingHomogenization(1,ip,el)
instance = vacancyflux_typeInstance(homog)
Cv = vacancyfluxState(homog)%subState0(1,offset)
call vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el)
Cv = Cv + subdt*Cvdot
vacancyflux_isochempot_updateState = [ abs(Cv - vacancyfluxState(homog)%state(1,offset)) &
<= err_vacancyflux_tolAbs &
.or. abs(Cv - vacancyfluxState(homog)%state(1,offset)) &
<= err_vacancyflux_tolRel*abs(vacancyfluxState(homog)%state(1,offset)), &
.true.]
vacancyConc (homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = Cv
vacancyConcRate(homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = &
(vacancyfluxState(homog)%state(1,offset) - vacancyfluxState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal))
end function vacancyflux_isochempot_updateState
!--------------------------------------------------------------------------------------------------
!> @brief calculates homogenized vacancy driving forces
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el)
use material, only: &
homogenization_Ngrains, &
mappingHomogenization, &
phaseAt, &
phase_source, &
phase_Nsources, &
SOURCE_vacancy_phenoplasticity_ID, &
SOURCE_vacancy_irradiation_ID, &
SOURCE_vacancy_thermalfluc_ID
use source_vacancy_phenoplasticity, only: &
source_vacancy_phenoplasticity_getRateAndItsTangent
use source_vacancy_irradiation, only: &
source_vacancy_irradiation_getRateAndItsTangent
use source_vacancy_thermalfluc, only: &
source_vacancy_thermalfluc_getRateAndItsTangent
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
Cv
integer(pInt) :: &
phase, &
grain, &
source
real(pReal) :: &
CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv
CvDot = 0.0_pReal
dCvDot_dCv = 0.0_pReal
do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
phase = phaseAt(grain,ip,el)
do source = 1_pInt, phase_Nsources(phase)
select case(phase_source(source,phase))
case (SOURCE_vacancy_phenoplasticity_ID)
call source_vacancy_phenoplasticity_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el)
case (SOURCE_vacancy_irradiation_ID)
call source_vacancy_irradiation_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el)
case (SOURCE_vacancy_thermalfluc_ID)
call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip, el)
end select
CvDot = CvDot + localCvDot
dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv
enddo
enddo
CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
end subroutine vacancyflux_isochempot_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of vacancy transport results
!--------------------------------------------------------------------------------------------------
function vacancyflux_isochempot_postResults(ip,el)
use material, only: &
mappingHomogenization, &
vacancyflux_typeInstance, &
vacancyConc, &
vacancyfluxMapping
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(vacancyflux_isochempot_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: &
vacancyflux_isochempot_postResults
integer(pInt) :: &
instance, homog, offset, o, c
homog = mappingHomogenization(2,ip,el)
offset = vacancyfluxMapping(homog)%p(ip,el)
instance = vacancyflux_typeInstance(homog)
c = 0_pInt
vacancyflux_isochempot_postResults = 0.0_pReal
do o = 1_pInt,vacancyflux_isochempot_Noutput(instance)
select case(vacancyflux_isochempot_outputID(o,instance))
case (vacancyconc_ID)
vacancyflux_isochempot_postResults(c+1_pInt) = vacancyConc(homog)%p(offset)
c = c + 1
end select
enddo
end function vacancyflux_isochempot_postResults
end module vacancyflux_isochempot

62
src/vacancyflux_isoconc.f90
View File

@ -1,62 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for constant vacancy concentration
!--------------------------------------------------------------------------------------------------
module vacancyflux_isoconc
implicit none
private
public :: &
vacancyflux_isoconc_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine vacancyflux_isoconc_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pReal, &
pInt
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &
homog, &
NofMyHomog
write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isoconc_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (vacancyflux_type(homog) == VACANCYFLUX_isoconc_ID) then
NofMyHomog = count(material_homog == homog)
vacancyfluxState(homog)%sizeState = 0_pInt
vacancyfluxState(homog)%sizePostResults = 0_pInt
allocate(vacancyfluxState(homog)%state0 (0_pInt,NofMyHomog))
allocate(vacancyfluxState(homog)%subState0(0_pInt,NofMyHomog))
allocate(vacancyfluxState(homog)%state (0_pInt,NofMyHomog))
deallocate(vacancyConc (homog)%p)
allocate (vacancyConc (homog)%p(1), source=vacancyflux_initialCv(homog))
deallocate(vacancyConcRate(homog)%p)
allocate (vacancyConcRate(homog)%p(1), source=0.0_pReal)
endif myhomog
enddo initializeInstances
end subroutine vacancyflux_isoconc_init
end module vacancyflux_isoconc