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

Merge branch 'MiscImprovements' into development

This commit is contained in:
Martin Diehl 2019-03-10 14:51:40 +01:00
parent 17d8826cba f203add899
commit ecfc5d26e3
76 changed files with 2898 additions and 3534 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
.gitlab-ci.yml
View File

@ -3,8 +3,7 @@ stages:
- prepareAll
- preprocessing
- postprocessing
- compilePETScIntel
- compilePETScGNU
- compilePETSc
- prepareSpectral
- spectral
- compileMarc
@ -50,7 +49,7 @@ variables:
# ===============================================================================================
# Names of module files to load
# ===============================================================================================
# ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++
# ++++++++++++ Compiler +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016"
IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017"
IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018"
@ -58,19 +57,19 @@ variables:
# ------------ Defaults ----------------------------------------------
IntelCompiler: "$IntelCompiler18_4"
GNUCompiler: "$GNUCompiler8_2"
# ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++
# ++++++++++++ MPI ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
IMPI2018Intel18_4: "MPI/Intel/18.4/IntelMPI/2018"
MPICH3_3GNU8_2: "MPI/GNU/8.2/MPICH/3.3"
# ------------ Defaults ----------------------------------------------
MPICH_Intel: "$IMPI2018Intel18_4"
MPICH_GNU: "$MPICH3_3GNU8_2"
# ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++
# ++++++++++++ PETSc ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
PETSc3_10_3IMPI2018Intel18_4: "Libraries/PETSc/3.10.3/Intel-18.4-IntelMPI-2018"
PETSc3_10_3MPICH3_3GNU8_2: "Libraries/PETSc/3.10.3/GNU-8.2-MPICH-3.3"
# ------------ Defaults ----------------------------------------------
PETSc_MPICH_Intel: "$PETSc3_10_3IMPI2018Intel18_4"
PETSc_MPICH_GNU: "$PETSc3_10_3MPICH3_3GNU8_2"
# ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++
# ++++++++++++ commercial FEM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Abaqus2019: "FEM/Abaqus/2019"
MSC2018_1: "FEM/MSC/2018.1"
# ------------ Defaults ----------------------------------------------
@ -78,7 +77,8 @@ variables:
MSC: "$MSC2018_1"
IntelMarc: "$IntelCompiler17_8"
IntelAbaqus: "$IntelCompiler16_4"
# ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++
HDF5Marc: "HDF5/1.10.4/Intel-17.8"
# ++++++++++++ Documentation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Doxygen1_8_15: "Documentation/Doxygen/1.8.15"
# ------------ Defaults ----------------------------------------------
Doxygen: "$Doxygen1_8_15"
@ -216,38 +216,41 @@ Post_OrientationConversion:
###################################################################################################
Compile_Spectral_Intel:
stage: compilePETScIntel
stage: compilePETSc
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- SpectralAll_compile/test.py
- cp -r SpectralAll_compile SpectralAll_compile_Intel
- SpectralAll_compile_Intel/test.py
except:
- master
- release
Compile_FEM_Intel:
stage: compilePETScIntel
stage: compilePETSc
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- FEM_compile/test.py
- cp -r FEM_compile FEM_compile_Intel
- FEM_compile_Intel/test.py
except:
- master
- release
###################################################################################################
Compile_Spectral_GNU:
stage: compilePETScGNU
stage: compilePETSc
script:
- module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU
- SpectralAll_compile/test.py
- cp -r SpectralAll_compile SpectralAll_compile_GNU
- SpectralAll_compile_GNU/test.py
except:
- master
- release
Compile_FEM_GNU:
stage: compilePETScGNU
stage: compilePETSc
script:
- module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU
- FEM_compile/test.py
- cp -r FEM_compile FEM_compile_GNU
- FEM_compile_GNU/test.py
except:
- master
- release
@ -392,7 +395,8 @@ TextureComponents:
Marc_compileIfort2018_1:
stage: compileMarc
script:
- module load $IntelMarc $MSC
- module load $IntelMarc $HDF5Marc $MSC
- export DAMASK_HDF5=ON
- Marc_compileIfort/test.py -m 2018.1
except:
- master
@ -403,7 +407,7 @@ Marc_compileIfort2018_1:
Hex_elastic:
stage: marc
script:
- module load $IntelMarc $MSC
- module load $IntelMarc $HDF5Marc $MSC
- Hex_elastic/test.py
except:
- master
@ -412,7 +416,7 @@ Hex_elastic:
CubicFCC_elastic:
stage: marc
script:
- module load $IntelMarc $MSC
- module load $IntelMarc $HDF5Marc $MSC
- CubicFCC_elastic/test.py
except:
- master
@ -421,7 +425,7 @@ CubicFCC_elastic:
CubicBCC_elastic:
stage: marc
script:
- module load $IntelMarc $MSC
- module load $IntelMarc $HDF5Marc $MSC
- CubicBCC_elastic/test.py
except:
- master
@ -430,7 +434,7 @@ CubicBCC_elastic:
J2_plasticBehavior:
stage: marc
script:
- module load $IntelMarc $MSC
- module load $IntelMarc $HDF5Marc $MSC
- J2_plasticBehavior/test.py
except:
- master

10
CMakeLists.txt
View File

@ -182,8 +182,6 @@ add_definitions (-DDAMASKVERSION="${DAMASK_V}")
# definition of other macros
add_definitions (-DPETSc)
add_definitions (-DFLOAT=8)
add_definitions (-DINT=4)
set (DAMASK_INCLUDE_FLAGS "${DAMASK_INCLUDE_FLAGS} ${PETSC_INCLUDES}")
@ -207,7 +205,7 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
# -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules
# (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172)
set (STANDARD_CHECK "-stand f08 -standard-semantics -assume nostd_mod_proc_name")
set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name")
set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel")
# Link against shared Intel libraries instead of static ones
@ -303,8 +301,6 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
# precision settings
set (PRECISION_FLAGS "${PRECISION_FLAGS} -real-size 64")
# set precision for standard real to 32 | 64 | 128 (= 4 | 8 | 16 bytes, type pReal is always 8 bytes)
set (PRECISION_FLAGS "${PRECISION_FLAGS} -integer-size 32")
# set precision for standard int to 16 | 32 | 64 (= 2 | 4 | 8 bytes, type pInt is always 4 bytes)
###################################################################################################
@ -439,13 +435,9 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
# precision settings
set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-real-8")
# set precision to 8 bytes for standard real (=8 for pReal). Will set size of double to 16 bytes as long as -fdefault-double-8 is not set
set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-double-8")
# set precision to 8 bytes for double real, would be 16 bytes if -fdefault-real-8 is used
# 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

2
PRIVATE

@ -1 +1 @@
Subproject commit 35bfe75dfc93e8b708b2e0349ce2fb89ceae1ad4
Subproject commit c79dc5f1be75f90b0638c230d56c962bfd3b2474

5
installation/mods_Abaqus/abaqus_v6.env
View File

@ -36,15 +36,14 @@ else:
# -implicitnone assume no implicit types (e.g. i for integer)
# -standard-semantics sets standard (Fortran 2008) and some other conventions
# -assume nostd_mod_proc_name avoid problems with libraries compiled without that option
# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal
# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt
# -real-size 64 assume size of real to be 8 bytes, matches our definition of pReal
compile_fortran = (fortCmd + " -c -fPIC -auto -shared-intel " +
"-I%I -free -O3 -fpp -fopenmp " +
"-ftz -diag-disable 5268 " +
"-implicitnone -standard-semantics " +
"-assume nostd_mod_proc_name " +
"-real-size 64 -integer-size 32 -DFLOAT=8 -DINT=4 " +
"-real-size 64 " +
'-DDAMASKVERSION=\\\"%s\\\"'%DAMASKVERSION)
# Abaqus/CAE will generate an input file without parts and assemblies.

5
installation/mods_Abaqus/abaqus_v6_debug.env
View File

@ -36,8 +36,7 @@ else:
# -implicitnone assume no implicit types (e.g. i for integer)
# -standard-semantics sets standard (Fortran 2008) and some other conventions
# -assume nostd_mod_proc_name avoid problems with libraries compiled without that option
# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal
# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt
# -real-size 64 assume size of real to be 8 bytes, matches our definition of pReal
# 'check pointers' does not work
@ -46,7 +45,7 @@ compile_fortran = (fortCmd + " -c -fPIC -auto -shared-intel " +
"-ftz -diag-disable 5268 " +
"-implicitnone -standard-semantics " +
"-assume nostd_mod_proc_name " +
"-real-size 64 -integer-size 32 -DFLOAT=8 -DINT=4 " +
"-real-size 64 " +
"-check bounds,format,output_conversion,uninit " +
"-ftrapuv -fpe-all0 " +
"-g -traceback -gen-interfaces -fp-stack-check -fp-model strict " +

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

@ -400,12 +400,12 @@ MARCCODEPROF=
#MARCCODEPROF="ON"
if test "$MARC_INTEGER_SIZE" = "i4" ; then
I8FFLAGS="-real-size 64 -integer-size 32"
I8DEFINES="-DFLOAT=8 -DINT=4"
I8FFLAGS=
I8DEFINES=
I8CDEFINES=
else
I8FFLAGS="-i8 -real-size 64 -integer-size 64"
I8DEFINES="-DI64 -DFLOAT=8 -DINT=8"
I8FFLAGS="-i8 -integer-size 64"
I8DEFINES="-DI64 -DINT=8"
I8CDEFINES="-U_DOUBLE -D_SINGLE"
fi

8
installation/mods_MarcMentat/2018/Marc_tools/include_linux64
View File

@ -391,12 +391,12 @@ MARCCODEPROF=
#MARCCODEPROF="ON"
if test "$MARC_INTEGER_SIZE" = "i4" ; then
I8FFLAGS="-real-size 64 -integer-size 32"
I8DEFINES="-DFLOAT=8 -DINT=4"
I8FFLAGS=
I8DEFINES=
I8CDEFINES=
else
I8FFLAGS="-i8 -real-size 64 -integer-size 64"
I8DEFINES="-DI64 -DFLOAT=8 -DINT=8"
I8FFLAGS="-i8 -integer-size 64"
I8DEFINES="-DI64 -DINT=8"
I8CDEFINES="-U_DOUBLE -D_SINGLE"
fi

24
processing/post/addOrientations.py
View File

@ -22,11 +22,11 @@ Additional (globally fixed) rotations of the lab frame and/or crystal frame can
""", version = scriptID)
representations = {
'quaternion': ['quat',4], #ToDo: Use here Rowenhorst names (qu/ro/om/ax?)
'rodrigues': ['rodr',4],
'eulers': ['eulr',3],
'matrix': ['mtrx',9],
'angleaxis': ['aaxs',4],
'quaternion': ['qu',4],
'rodrigues': ['ro',4],
'eulers': ['eu',3],
'matrix': ['om',9],
'angleaxis': ['ax',4],
}
parser.add_option('-o',
@ -43,12 +43,12 @@ parser.add_option('-R',
'--labrotation',
dest='labrotation',
type = 'float', nargs = 4, metavar = ' '.join(['float']*4),
help = 'angle and axis of additional lab frame rotation [%default]')
help = 'axis and angle of additional lab frame rotation [%default]')
parser.add_option('-r',
'--crystalrotation',
dest='crystalrotation',
type = 'float', nargs = 4, metavar = ' '.join(['float']*4),
help = 'angle and axis of additional crystal frame rotation [%default]')
help = 'axis and angle of additional crystal frame rotation [%default]')
parser.add_option('--eulers',
dest = 'eulers',
metavar = 'string',
@ -79,8 +79,8 @@ parser.add_option('-z',
help = 'label of lab z vector (expressed in crystal coords)')
parser.set_defaults(output = [],
labrotation = (0.,1.,0.,0.), # no rotation about 1,0,0
crystalrotation = (0.,1.,0.,0.), # no rotation about 1,0,0
labrotation = (1.,1.,1.,0.), # no rotation about (1,1,1)
crystalrotation = (1.,1.,1.,0.), # no rotation about (1,1,1)
)
(options, filenames) = parser.parse_args()
@ -107,10 +107,8 @@ if np.sum(input) != 1: parser.error('needs exactly one input format.')
(options.quaternion,representations['quaternion'][1],'quaternion'),
][np.where(input)[0][0]] # select input label that was requested
crystalrotation = np.array(options.crystalrotation[1:4] + (options.crystalrotation[0],)) # Compatibility hack
labrotation = np.array(options.labrotation[1:4] + (options.labrotation[0],)) # Compatibility hack
r = damask.Rotation.fromAxisAngle(crystalrotation,options.degrees) # crystal frame rotation
R = damask.Rotation.fromAxisAngle(labrotation,options.degrees) # lab frame rotation
r = damask.Rotation.fromAxisAngle(np.array(options.crystalrotation),options.degrees,normalise=True)
R = damask.Rotation.fromAxisAngle(np.array(options.labrotation),options.degrees,normalise=True)
# --- loop over input files ------------------------------------------------------------------------

7
processing/post/rotateData.py
View File

@ -25,13 +25,13 @@ parser.add_option('-d', '--data',
parser.add_option('-r', '--rotation',
dest = 'rotation',
type = 'float', nargs = 4, metavar = ' '.join(['float']*4),
help = 'angle and axis to rotate data [%default]')
help = 'axis and angle to rotate data [%default]')
parser.add_option('--degrees',
dest = 'degrees',
action = 'store_true',
help = 'angles are given in degrees')
parser.set_defaults(rotation = (0.,1.,1.,1.), # no rotation about 1,1,1
parser.set_defaults(rotation = (1.,1.,1.,0), # no rotation about (1,1,1)
degrees = False,
)
@ -40,8 +40,7 @@ parser.set_defaults(rotation = (0.,1.,1.,1.),
if options.data is None:
parser.error('no data column specified.')
rotation = np.array(options.rotation[1:4]+(options.rotation[0],)) # Compatibility hack
r = damask.Rotation.fromAxisAngle(rotation,options.degrees,normalise=True)
r = damask.Rotation.fromAxisAngle(np.array(options.rotation),options.degrees,normalise=True)
# --- loop over input files -------------------------------------------------------------------------

2
processing/post/sortTable.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys

3
processing/post/vtk_addGridData.py
View File

@ -67,7 +67,6 @@ elif vtk_ext == '.vtk':
reader.Update()
rGrid = reader.GetRectilinearGridOutput()
writer = vtk.vtkXMLRectilinearGridWriter()
vtk_ext = '.vtr'
elif vtk_ext == '.vtu':
reader = vtk.vtkXMLUnstructuredGridReader()
reader.SetFileName(options.vtk)
@ -77,7 +76,7 @@ elif vtk_ext == '.vtu':
else:
parser.error('Unsupported VTK file type extension.')
writer.SetFileName(vtk_file+vtk_ext)
writer.SetFileName(vtk_file+'.'+writer.GetDefaultFileExtension())
Npoints = rGrid.GetNumberOfPoints()
Ncells = rGrid.GetNumberOfCells()

3
processing/post/vtk_addPointCloudData.py
View File

@ -61,7 +61,6 @@ elif vtk_ext == '.vtk':
reader.SetFileName(options.vtk)
reader.Update()
Polydata = reader.GetPolyDataOutput()
vtk_ext = '.vtp'
else:
parser.error('unsupported VTK file type extension.')
@ -152,7 +151,7 @@ for name in filenames:
writer = vtk.vtkXMLPolyDataWriter()
writer.SetDataModeToBinary()
writer.SetCompressorTypeToZLib()
writer.SetFileName(vtk_file+vtk_ext)
writer.SetFileName(vtk_file+'.'+writer.GetDefaultFileExtension())
writer.SetInputData(Polydata)
writer.Write()

3
processing/post/vtk_addRectilinearGridData.py
View File

@ -64,7 +64,6 @@ elif vtk_ext == '.vtk':
reader.SetFileName(options.vtk)
reader.Update()
rGrid = reader.GetRectilinearGridOutput()
vtk_ext = '.vtr'
else:
parser.error('unsupported VTK file type extension.')
@ -161,7 +160,7 @@ for name in filenames:
writer = vtk.vtkXMLRectilinearGridWriter()
writer.SetDataModeToBinary()
writer.SetCompressorTypeToZLib()
writer.SetFileName(vtk_file+vtk_ext)
writer.SetFileName(vtk_file+'.'+writer.GetDefaultFileExtension())
writer.SetInputData(rGrid)
writer.Write()

32
processing/pre/geom_addPrimitive.py
View File

@ -31,25 +31,34 @@ Depending on the sign of the dimension parameters, these objects can be boxes, c
""", version = scriptID)
parser.add_option('-c', '--center', dest='center', type='float', nargs = 3, metavar=' '.join(['float']*3),
parser.add_option('-c', '--center', dest='center',
type='float', nargs = 3, metavar=' '.join(['float']*3),
help='a,b,c origin of primitive %default')
parser.add_option('-d', '--dimension', dest='dimension', type='float', nargs = 3, metavar=' '.join(['float']*3),
parser.add_option('-d', '--dimension', dest='dimension',
type='float', nargs = 3, metavar=' '.join(['float']*3),
help='a,b,c extension of hexahedral box; negative values are diameters')
parser.add_option('-e', '--exponent', dest='exponent', type='float', nargs = 3, metavar=' '.join(['float']*3),
parser.add_option('-e', '--exponent', dest='exponent',
type='float', nargs = 3, metavar=' '.join(['float']*3),
help='i,j,k exponents for axes - 0 gives octahedron (|x|^(2^0) + |y|^(2^0) + |z|^(2^0) < 1), \
1 gives a sphere (|x|^(2^1) + |y|^(2^1) + |z|^(2^1) < 1), \
large values produce boxes, negative turns concave.')
parser.add_option('-f', '--fill', dest='fill', type='int', metavar = 'int',
parser.add_option('-f', '--fill', dest='fill',
type='int', metavar = 'int',
help='grain index to fill primitive. "0" selects maximum microstructure index + 1 [%default]')
parser.add_option('-q', '--quaternion', dest='quaternion', type='float', nargs = 4, metavar=' '.join(['float']*4),
parser.add_option('-q', '--quaternion', dest='quaternion',
type='float', nargs = 4, metavar=' '.join(['float']*4),
help = 'rotation of primitive as quaternion')
parser.add_option('-a', '--angleaxis', dest='angleaxis', nargs = 4, metavar=' '.join(['float']*4), type=float,
help = 'angle,x,y,z clockwise rotation of primitive about axis by angle')
parser.add_option( '--degrees', dest='degrees', action='store_true',
parser.add_option('-a', '--angleaxis', dest='angleaxis', type=float,
nargs = 4, metavar=' '.join(['float']*4),
help = 'axis and angle to rotate primitive')
parser.add_option( '--degrees', dest='degrees',
action='store_true',
help = 'angle is given in degrees [%default]')
parser.add_option( '--nonperiodic', dest='periodic', action='store_false',
parser.add_option( '--nonperiodic', dest='periodic',
action='store_false',
help = 'wrap around edges [%default]')
parser.add_option( '--realspace', dest='realspace', action='store_true',
parser.add_option( '--realspace', dest='realspace',
action='store_true',
help = '-c and -d span [origin,origin+size] instead of [0,grid] coordinates')
parser.set_defaults(center = (.0,.0,.0),
fill = 0,
@ -63,8 +72,7 @@ parser.set_defaults(center = (.0,.0,.0),
if options.dimension is None:
parser.error('no dimension specified.')
if options.angleaxis is not None:
ax = np.array(options.angleaxis[1:4] + (options.angleaxis[0],)) # Compatibility hack
rotation = damask.Rotation.fromAxisAngle(ax,options.degrees,normalise=True)
rotation = damask.Rotation.fromAxisAngle(np.array(options.angleaxis),options.degrees,normalise=True)
elif options.quaternion is not None:
rotation = damask.Rotation.fromQuaternion(options.quaternion)
else:

73
python/damask/util.py
View File

@ -1,5 +1,5 @@
# -*- coding: UTF-8 no BOM -*-
import sys,time,random,threading,os,subprocess,shlex
import sys,time,os,subprocess,shlex
import numpy as np
from optparse import Option
@ -169,77 +169,6 @@ def progressBar(iteration, total, prefix='', bar_length=50):
if iteration == total: sys.stderr.write('\n')
sys.stderr.flush()
# -----------------------------
class backgroundMessage(threading.Thread):
"""Reporting with animation to indicate progress"""
choices = {'bounce': ['_', 'o', 'O', '°', '‾', '‾', '°', 'O', 'o', '_'],
'spin': ['◜', '◝', '◞', '◟'],
'circle': ['◴', '◵', '◶', '◷'],
'hexagon': ['⬢', '⬣'],
'square': ['▖', '▘', '▝', '▗'],
'triangle': ['ᐊ', 'ᐊ', 'ᐃ', 'ᐅ', 'ᐅ', 'ᐃ'],
'amoeba': ['▖', '▏', '▘', '▔', '▝', '▕', '▗', '▁'],
'beat': ['▁', '▂', '▃', '▅', '▆', '▇', '▇', '▆', '▅', '▃', '▂'],
'prison': ['ᚋ', 'ᚌ', 'ᚍ', 'ᚏ', 'ᚎ', 'ᚍ', 'ᚌ', 'ᚋ'],
'breath': ['ᚐ', 'ᚑ', 'ᚒ', 'ᚓ', 'ᚔ', 'ᚓ', 'ᚒ', 'ᚑ', 'ᚐ'],
'pulse': ['·', '•', '●', '●', '•'],
'ant': ['⠁', '⠂', '⠐', '⠠', '⠄', '⡀', '⢀', '⠠', '⠄', '⠂', '⠐', '⠈'],
'juggle': ['꜈', '꜉', '꜊', '꜋', '꜌', '꜑', '꜐', '꜏', '꜍'],
# 'wobbler': ['▁', '◣', '▏', '◤', '▔', '◥', '▕', '◢'],
'grout': ['▁', '▏', '▔', '▕'],
'partner': ['⚬', '⚭', '⚮', '⚯', '⚮', '⚭'],
'classic': ['-', '\\', '|', '/',],
}
def __init__(self,symbol = None,wait = 0.1):
"""Sets animation symbol"""
super(backgroundMessage, self).__init__()
self._stop = threading.Event()
self.message = ''
self.new_message = ''
self.counter = 0
self.gap = ' '
self.symbols = self.choices[symbol if symbol in self.choices else random.choice(list(self.choices.keys()))]
self.waittime = wait
def __quit__(self):
"""Cleans output"""
length = len(self.symbols[self.counter] + self.gap + self.message)
sys.stderr.write(chr(8)*length + ' '*length + chr(8)*length)
sys.stderr.write('')
sys.stderr.flush()
def stop(self):
self._stop.set()
def stopped(self):
return self._stop.is_set()
def run(self):
while not threading.enumerate()[0]._Thread__stopped:
time.sleep(self.waittime)
self.update_message()
self.__quit__()
def set_message(self, new_message):
self.new_message = new_message
self.print_message()
def print_message(self):
length = len(self.symbols[self.counter] + self.gap + self.message)
sys.stderr.write(chr(8)*length + ' '*length + chr(8)*length + \
self.symbols[self.counter] + self.gap + self.new_message) # delete former and print new message
sys.stderr.flush()
self.message = self.new_message
def update_message(self):
self.counter = (self.counter + 1)%len(self.symbols)
self.print_message()
def animation(self,which = None):
return ''.join(self.choices[which]) if which in self.choices else ''
def leastsqBound(func, x0, args=(), bounds=None, Dfun=None, full_output=0,
col_deriv=0, ftol=1.49012e-8, xtol=1.49012e-8,

2
src/CMakeLists.txt
View File

@ -19,7 +19,7 @@ add_library(PREC OBJECT "prec.f90")
list(APPEND OBJECTFILES $<TARGET_OBJECTS:PREC>)
add_library(ELEMENT OBJECT "element.f90")
add_dependencies(ELEMENT PREC)
add_dependencies(ELEMENT IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:ELEMENT>)
add_library(QUIT OBJECT "quit.f90")

264
src/CPFEM.f90
View File

@ -116,20 +116,8 @@ end subroutine CPFEM_initAll
!> @brief allocate the arrays defined in module CPFEM and initialize them
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_init
#if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pInt
use IO, only: &
IO_read_realFile,&
IO_read_intFile, &
IO_timeStamp, &
IO_error
use numerics, only: &
worldrank
use debug, only: &
debug_level, &
debug_CPFEM, &
@ -154,88 +142,82 @@ subroutine CPFEM_init
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_Tstar0_v
crystallite_S0
implicit none
integer(pInt) :: k,l,m,ph,homog
character(len=1024) :: rankStr
integer :: k,l,m,ph,homog
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
flush(6)
endif mainProcess
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
flush(6)
allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
! *** restore the last converged values of each essential variable from the binary file
if (restartRead) then
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then
write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files'
flush(6)
endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase))
read (777,rec=1) material_phase
close (777)
call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0))
read (777,rec=1) crystallite_F0
close (777)
call IO_read_realFile(777,'convergedFp'//trim(rankStr),modelName,size(crystallite_Fp0))
read (777,rec=1) crystallite_Fp0
close (777)
call IO_read_realFile(777,'convergedFi'//trim(rankStr),modelName,size(crystallite_Fi0))
read (777,rec=1) crystallite_Fi0
close (777)
call IO_read_realFile(777,'convergedLp'//trim(rankStr),modelName,size(crystallite_Lp0))
read (777,rec=1) crystallite_Lp0
close (777)
call IO_read_realFile(777,'convergedLi'//trim(rankStr),modelName,size(crystallite_Li0))
read (777,rec=1) crystallite_Li0
close (777)
!if (restartRead) then
! if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then
! write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files'
! flush(6)
! endif
call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v))
read (777,rec=1) crystallite_Tstar0_v
close (777)
! call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase))
! read (777,rec=1) material_phase
! close (777)
call IO_read_realFile(777,'convergedStateConst'//trim(rankStr),modelName)
m = 0_pInt
readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState
do l = 1, size(plasticState(ph)%state0(1,:))
m = m+1_pInt
read(777,rec=m) plasticState(ph)%state0(k,l)
enddo; enddo
enddo readPlasticityInstances
close (777)
! call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0))
! read (777,rec=1) crystallite_F0
! close (777)
call IO_read_realFile(777,'convergedStateHomog'//trim(rankStr),modelName)
m = 0_pInt
readHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState
do l = 1, size(homogState(homog)%state0(1,:))
m = m+1_pInt
read(777,rec=m) homogState(homog)%state0(k,l)
enddo; enddo
enddo readHomogInstances
close (777)
! call IO_read_realFile(777,'convergedFp'//trim(rankStr),modelName,size(crystallite_Fp0))
! read (777,rec=1) crystallite_Fp0
! close (777)
call IO_read_realFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE))
read (777,rec=1) CPFEM_dcsdE
close (777)
restartRead = .false.
endif
! call IO_read_realFile(777,'convergedFi'//trim(rankStr),modelName,size(crystallite_Fi0))
! read (777,rec=1) crystallite_Fi0
! close (777)
! call IO_read_realFile(777,'convergedLp'//trim(rankStr),modelName,size(crystallite_Lp0))
! read (777,rec=1) crystallite_Lp0
! close (777)
! call IO_read_realFile(777,'convergedLi'//trim(rankStr),modelName,size(crystallite_Li0))
! read (777,rec=1) crystallite_Li0
! close (777)
! call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v))
! read (777,rec=1) crystallite_Tstar0_v
! close (777)
! call IO_read_realFile(777,'convergedStateConst'//trim(rankStr),modelName)
! m = 0_pInt
! readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
! do k = 1_pInt, plasticState(ph)%sizeState
! do l = 1, size(plasticState(ph)%state0(1,:))
! m = m+1_pInt
! read(777,rec=m) plasticState(ph)%state0(k,l)
! enddo; enddo
! enddo readPlasticityInstances
! close (777)
! call IO_read_realFile(777,'convergedStateHomog'//trim(rankStr),modelName)
! m = 0_pInt
! readHomogInstances: do homog = 1_pInt, material_Nhomogenization
! do k = 1_pInt, homogState(homog)%sizeState
! do l = 1, size(homogState(homog)%state0(1,:))
! m = m+1_pInt
! read(777,rec=m) homogState(homog)%state0(k,l)
! enddo; enddo
! enddo readHomogInstances
! close (777)
! call IO_read_realFile(777,'convergeddcsdE',modelName,size(CPFEM_dcsdE))
! read (777,rec=1) CPFEM_dcsdE
! close (777)
! restartRead = .false.
!endif
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE)
@ -253,8 +235,7 @@ end subroutine CPFEM_init
subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyStress, jacobian)
use numerics, only: &
defgradTolerance, &
iJacoStiffness, &
worldrank
iJacoStiffness
use debug, only: &
debug_level, &
debug_CPFEM, &
@ -319,8 +300,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF, &
crystallite_Tstar0_v, &
crystallite_Tstar_v
crystallite_S0, &
crystallite_S
use homogenization, only: &
materialpoint_F, &
materialpoint_F0, &
@ -331,7 +312,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
materialpoint_stressAndItsTangent, &
materialpoint_postResults
use IO, only: &
IO_write_jobRealFile, &
IO_warning
use DAMASK_interface
@ -358,7 +338,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
integer(pInt) elCP, & ! crystal plasticity element number
i, j, k, l, m, n, ph, homog, mySource
logical updateJaco ! flag indicating if JAcobian has to be updated
character(len=1024) :: rankStr
elCP = mesh_FEasCP('elem',elFE)
@ -384,12 +363,12 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
!*** age results and write restart data if requested
if (iand(mode, CPFEM_AGERESULTS) /= 0_pInt) then
crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...)
crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation
crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity
crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation
crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity
crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress
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_S0 = crystallite_S ! crystallite 2nd Piola Kirchhoff stress
forall ( i = 1:size(plasticState )) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array
do i = 1, size(sourceState)
@ -414,68 +393,67 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
! * dump the last converged values of each essential variable to a binary file
if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files'
write(rankStr,'(a1,i0)')'_',worldrank
!if (restartWrite) then
! if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
! write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files'
!
call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase))
write (777,rec=1) material_phase
close (777)
! call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase))
! write (777,rec=1) material_phase
! close (777)
call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0))
write (777,rec=1) crystallite_F0
close (777)
! call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0))
! write (777,rec=1) crystallite_F0
! close (777)
call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0))
write (777,rec=1) crystallite_Fp0
close (777)
! call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0))
! write (777,rec=1) crystallite_Fp0
! close (777)
call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0))
write (777,rec=1) crystallite_Fi0
close (777)
! call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0))
! write (777,rec=1) crystallite_Fi0
! close (777)
call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0))
write (777,rec=1) crystallite_Lp0
close (777)
! call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0))
! write (777,rec=1) crystallite_Lp0
! close (777)
call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0))
write (777,rec=1) crystallite_Li0
close (777)
! call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0))
! write (777,rec=1) crystallite_Li0
! close (777)
call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v))
write (777,rec=1) crystallite_Tstar0_v
close (777)
! call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v))
! write (777,rec=1) crystallite_Tstar0_v
! close (777)
call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr))
m = 0_pInt
writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState
do l = 1, size(plasticState(ph)%state0(1,:))
m = m+1_pInt
write(777,rec=m) plasticState(ph)%state0(k,l)
enddo; enddo
enddo writePlasticityInstances
close (777)
! call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr))
! m = 0_pInt
! writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
! do k = 1_pInt, plasticState(ph)%sizeState
! do l = 1, size(plasticState(ph)%state0(1,:))
! m = m+1_pInt
! write(777,rec=m) plasticState(ph)%state0(k,l)
! enddo; enddo
! enddo writePlasticityInstances
! close (777)
call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr))
m = 0_pInt
writeHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState
do l = 1, size(homogState(homog)%state0(1,:))
m = m+1_pInt
write(777,rec=m) homogState(homog)%state0(k,l)
enddo; enddo
enddo writeHomogInstances
close (777)
! call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr))
! m = 0_pInt
! writeHomogInstances: do homog = 1_pInt, material_Nhomogenization
! do k = 1_pInt, homogState(homog)%sizeState
! do l = 1, size(homogState(homog)%state0(1,:))
! m = m+1_pInt
! write(777,rec=m) homogState(homog)%state0(k,l)
! enddo; enddo
! enddo writeHomogInstances
! close (777)
call IO_write_jobRealFile(777,'convergeddcsdE',size(CPFEM_dcsdE))
write (777,rec=1) CPFEM_dcsdE
close (777)
! call IO_write_jobRealFile(777,'convergeddcsdE',size(CPFEM_dcsdE))
! write (777,rec=1) CPFEM_dcsdE
! close (777)
endif
endif ! results aging
!endif
endif

34
src/CPFEM2.f90
View File

@ -87,15 +87,9 @@ end subroutine CPFEM_initAll
!> @brief allocate the arrays defined in module CPFEM and initialize them
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pInt, pReal
use IO, only: &
IO_timeStamp, &
IO_error
use numerics, only: &
worldrank
@ -119,7 +113,7 @@ subroutine CPFEM_init
crystallite_Lp0, &
crystallite_Fi0, &
crystallite_Li0, &
crystallite_Tstar0_v
crystallite_S0
use hdf5
use HDF5_utilities, only: &
HDF5_openFile, &
@ -136,8 +130,6 @@ subroutine CPFEM_init
integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
flush(6)
! *** restore the last converged values of each essential variable from the binary file
@ -157,7 +149,7 @@ subroutine CPFEM_init
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')
call HDF5_read(fileHandle,crystallite_S0, 'convergedS')
groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
do ph = 1_pInt,size(phase_plasticity)
@ -220,12 +212,8 @@ subroutine CPFEM_age()
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF, &
crystallite_Tstar0_v, &
crystallite_Tstar_v
use IO, only: &
IO_write_jobRealFile, &
IO_warning
crystallite_S0, &
crystallite_S
use HDF5_utilities, only: &
HDF5_openFile, &
HDF5_closeFile, &
@ -249,15 +237,15 @@ subroutine CPFEM_age()
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
crystallite_S0 = crystallite_S
do i = 1, size(plasticState)
plasticState(i)%state0 = plasticState(i)%state
enddo
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
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state
enddo; enddo
do homog = 1_pInt, material_Nhomogenization
homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state
@ -277,7 +265,7 @@ subroutine CPFEM_age()
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')
call HDF5_write(fileHandle,crystallite_S0, 'convergedS')
groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
do ph = 1_pInt,size(phase_plasticity)

10
src/DAMASK_FEM.f90
View File

@ -7,11 +7,6 @@
!> results
!--------------------------------------------------------------------------------------------------
program DAMASK_FEM
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
#include <petsc/finclude/petscsys.h>
use PetscDM
use prec, only: &
@ -31,8 +26,7 @@ program DAMASK_FEM
IO_error, &
IO_lc, &
IO_intOut, &
IO_warning, &
IO_timeStamp
IO_warning
use math ! need to include the whole module for FFTW
use CPFEM2, only: &
CPFEM_initAll
@ -118,8 +112,6 @@ program DAMASK_FEM
! init DAMASK (all modules)
call CPFEM_initAll
write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
! reading basic information from load case file and allocate data structure containing load cases
call DMGetDimension(geomMesh,dimPlex,ierr)! CHKERRQ(ierr) !< dimension of mesh (2D or 3D)

29
src/DAMASK_abaqus.f
View File

@ -43,30 +43,31 @@ subroutine DAMASK_interface_init
implicit none
integer, dimension(8) :: &
dateAndTime ! type default integer
dateAndTime
integer :: lenOutDir,ierr
character(len=256) :: wd
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(/,a)') ' <<<+- DAMASK_abaqus init -+>>>'
write(6,'(a,/)') ' Version: '//DAMASKVERSION
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018'
write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(/,a)') ' Version: '//DAMASKVERSION
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with: ', compiler_version()
write(6,*) 'Compiler options: ', compiler_options()
write(6,'(/,a)') 'Compiled with: '//compiler_version()
write(6,'(a)') 'Compiler options: '//compiler_options()
#else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
write(6,'(/,a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
call date_and_time(values = dateAndTime)
write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
call getoutdir(wd, lenOutDir)
ierr = CHDIR(wd)
@ -75,8 +76,6 @@ subroutine DAMASK_interface_init
call quit(1)
endif
#include "compilation_info.f90"
end subroutine DAMASK_interface_init

70
src/DAMASK_interface.f90
View File

@ -45,6 +45,8 @@ subroutine DAMASK_interface_init()
use, intrinsic :: &
iso_c_binding
use PETScSys
use prec, only: &
pReal
use system_routines, only: &
signalusr1_C, &
signalusr2_C, &
@ -101,12 +103,14 @@ subroutine DAMASK_interface_init()
threadLevel, &
#endif
worldrank = 0, &
worldsize = 0
worldsize = 0, &
typeSize
integer, allocatable, dimension(:) :: &
chunkPos
integer, dimension(8) :: &
dateAndTime
PetscErrorCode :: ierr
integer :: mpi_err
PetscErrorCode :: petsc_err
external :: &
quit
@ -117,16 +121,21 @@ subroutine DAMASK_interface_init()
#ifdef _OPENMP
! If openMP is enabled, check if the MPI libary supports it and initialize accordingly.
! Otherwise, the first call to PETSc will do the initialization.
call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,ierr);CHKERRQ(ierr)
call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,mpi_err)
if (mpi_err /= 0) call quit(1)
if (threadLevel<MPI_THREAD_FUNNELED) then
write(6,'(a)') ' MPI library does not support OpenMP'
call quit(1)
endif
#endif
call PETScInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code
CHKERRQ(ierr) ! this is a macro definition, it is case sensitive
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)
call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr)
call PETScInitialize(PETSC_NULL_CHARACTER,petsc_err) ! according to PETSc manual, that should be the first line in the code
CHKERRQ(petsc_err) ! this is a macro definition, it is case sensitive
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,mpi_err)
if (mpi_err /= 0) call quit(1)
call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,mpi_err)
if (mpi_err /= 0) call quit(1)
mainProcess: if (worldrank == 0) then
if (output_unit /= 6) then
write(output_unit,'(a)') ' STDOUT != 6'
@ -141,29 +150,44 @@ subroutine DAMASK_interface_init()
open(6,file='/dev/null',status='replace') ! close(6) alone will leave some temp files in cwd
endif mainProcess
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(a,/)') ' Version: '//DAMASKVERSION
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018'
write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(/,a)') ' Version: '//DAMASKVERSION
! 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,*) 'Compiler options: ', compiler_options()
write(6,'(/,a)') 'Compiled with: '//compiler_version()
write(6,'(a)') 'Compiler options: '//compiler_options()
#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
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__
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,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
call date_and_time(values = dateAndTime)
write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
call MPI_Type_size(MPI_INTEGER,typeSize,mpi_err)
if (mpi_err /= 0) call quit(1)
if (typeSize*8 /= bit_size(0)) then
write(6,'(a)') ' Mismatch between MPI and DAMASK integer'
call quit(1)
endif
call MPI_Type_size(MPI_DOUBLE,typeSize,mpi_err)
if (mpi_err /= 0) call quit(1)
if (typeSize*8 /= storage_size(0.0_pReal)) then
write(6,'(a)') ' Mismatch between MPI and DAMASK real'
call quit(1)
endif
call get_command(commandLine)
chunkPos = IIO_stringPos(commandLine)
@ -369,7 +393,7 @@ end function getLoadCaseFile
function rectifyPath(path)
implicit none
character(len=*) :: path
character(len=*) :: path
character(len=1024) :: rectifyPath
integer :: i,j,k,l
@ -446,7 +470,7 @@ subroutine setSIGUSR1(signal) bind(C)
integer(C_INT), value :: signal
SIGUSR1 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR1'
write(6,'(a,i2.2,a)') ' received signal ',signal, ', set SIGUSR1'
end subroutine setSIGUSR1
@ -461,7 +485,7 @@ subroutine setSIGUSR2(signal) bind(C)
integer(C_INT), value :: signal
SIGUSR2 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR2'
write(6,'(a,i2.2,a)') ' received signal ',signal, ', set SIGUSR2'
end subroutine setSIGUSR2

31
src/DAMASK_marc.f90
View File

@ -54,32 +54,33 @@ subroutine DAMASK_interface_init
implicit none
integer, dimension(8) :: &
dateAndTime ! type default integer
dateAndTime
integer :: ierr
character(len=1024) :: wd
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(/,a)') ' <<<+- DAMASK_marc init -+>>>'
write(6,'(a,/)') ' Version: '//DAMASKVERSION
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420–478, 2018'
write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
write(6,'(/,a)') ' Version: '//DAMASKVERSION
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with: ', compiler_version()
write(6,*) 'Compiler options: ', compiler_options()
write(6,'(/,a)') 'Compiled with: '//compiler_version()
write(6,'(a)') 'Compiler options: '//compiler_options()
#else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
write(6,'(/,a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
call date_and_time(values = dateAndTime)
write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
inquire(5, name=wd) ! determine inputputfile
inquire(5, name=wd)
wd = wd(1:scan(wd,'/',back=.true.))
ierr = CHDIR(wd)
if (ierr /= 0) then

6
src/DAMASK_spectral.f90
View File

@ -246,7 +246,7 @@ program DAMASK_spectral
enddo
newLoadCase%deformation%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) ! logical mask in 3x3 notation
newLoadCase%deformation%maskFloat = merge(ones,zeros,newLoadCase%deformation%maskLogical)! float (1.0/0.0) mask in 3x3 notation
newLoadCase%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation
newLoadCase%deformation%values = math_9to33(temp_valueVector) ! values in 3x3 notation
case('p','pk1','piolakirchhoff','stress', 's')
temp_valueVector = 0.0_pReal
do j = 1_pInt, 9_pInt
@ -255,7 +255,7 @@ program DAMASK_spectral
enddo
newLoadCase%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3]))
newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical)
newLoadCase%stress%values = math_plain9to33(temp_valueVector)
newLoadCase%stress%values = math_9to33(temp_valueVector)
case('t','time','delta') ! increment time
newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt)
case('n','incs','increments','steps') ! number of increments
@ -291,7 +291,7 @@ program DAMASK_spectral
do j = 1_pInt, 9_pInt
temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j)
enddo
newLoadCase%rotation = math_plain9to33(temp_valueVector)
newLoadCase%rotation = math_9to33(temp_valueVector)
end select
enddo readIn

4
src/FEM_mech.f90
View File

@ -66,9 +66,7 @@ contains
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_init(fieldBC)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use IO, only: &
IO_timeStamp, &
IO_error
use DAMASK_interface, only: &
getSolverJobName
@ -111,8 +109,6 @@ subroutine FEM_mech_init(fieldBC)
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! Setup FEM mech mesh

45
src/FEM_utilities.f90
View File

@ -127,14 +127,6 @@ contains
!> @brief allocates all neccessary fields, sets debug flags
!--------------------------------------------------------------------------------------------------
subroutine utilities_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use DAMASK_interface, only: &
getSolverJobName
use IO, only: &
IO_error, &
IO_warning, &
IO_timeStamp, &
IO_open_file
use numerics, only: &
structOrder, &
integrationOrder, &
@ -155,20 +147,15 @@ subroutine utilities_init()
mesh_NcpElemsGlobal, &
mesh_maxNips, &
geomMesh
use material, only: &
material_homog
implicit none
character(len=1024) :: petsc_optionsPhysics
integer(pInt) :: dimPlex
PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:)
PetscInt :: dim
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! set debugging parameters
@ -194,24 +181,6 @@ subroutine utilities_init()
wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)
call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRQ(ierr)
allocate(nEntities(dimPlex+1), source=0)
allocate(nOutputNodes(worldsize), source = 0)
allocate(nOutputCells(worldsize), source = 0)
do dim = 0, dimPlex
call DMGetStratumSize(geomMesh,'depth',dim,nEntities(dim+1),ierr)
CHKERRQ(ierr)
enddo
select case (integrationOrder)
case(1_pInt)
nOutputNodes(worldrank+1) = nEntities(1)
case(2_pInt)
nOutputNodes(worldrank+1) = sum(nEntities)
case default
nOutputNodes(worldrank+1) = mesh_maxNips*nEntities(dimPlex+1)
end select
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)
end subroutine utilities_init
@ -287,6 +256,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
end subroutine utilities_constitutiveResponse
!--------------------------------------------------------------------------------------------------
!> @brief Create index sets of boundary dofs (in local and global numbering)
!--------------------------------------------------------------------------------------------------
@ -377,6 +347,7 @@ subroutine utilities_indexBoundaryDofs(dm_local,nFaceSets,numFields,local2global
end subroutine utilities_indexBoundaryDofs
!--------------------------------------------------------------------------------------------------
!> @brief Project BC values to local vector
!--------------------------------------------------------------------------------------------------
@ -502,24 +473,12 @@ end subroutine utilities_indexActiveSet
!> @brief cleans up
!--------------------------------------------------------------------------------------------------
subroutine utilities_destroy()
!use material, only: &
! homogenization_Ngrains
!implicit none
!PetscInt :: homog, cryst, grain, phase
!PetscErrorCode :: ierr
!call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr)
!call VecDestroy(coordinatesVec,ierr); CHKERRQ(ierr)
!do homog = 1, material_Nhomogenization
! call VecDestroy(homogenizationResultsVec(homog),ierr);CHKERRQ(ierr)
! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_Ngrains(homog)
! call VecDestroy(crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr)
! enddo; enddo
! do phase = 1, material_Nphase; do grain = 1, homogenization_Ngrains(homog)
! call VecDestroy(phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr)
! enddo; enddo
!enddo
!call PetscViewerDestroy(resUnit, ierr); CHKERRQ(ierr)
end subroutine utilities_destroy

182
src/HDF5_utilities.f90
View File

@ -14,8 +14,6 @@ module HDF5_utilities
implicit none
public
integer(pInt), parameter, private :: &
HDF5_ERR_TYPE = 4_pInt !< kind of the integer return in the HDF5 library
!--------------------------------------------------------------------------------------------------
!> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong
@ -91,7 +89,7 @@ contains
subroutine HDF5_utilities_init
implicit none
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(SIZE_T) :: typeSize
write(6,'(/,a)') ' <<<+- HDF5_Utilities init -+>>>'
@ -117,7 +115,7 @@ end subroutine HDF5_utilities_init
!--------------------------------------------------------------------------------------------------
!> @brief open and initializes HDF5 output file
!--------------------------------------------------------------------------------------------------
integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
integer(HID_T) function HDF5_openFile(fileName,mode,parallel) ! ToDo: simply "open" is enough
implicit none
character(len=*), intent(in) :: fileName
@ -126,7 +124,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
character :: m
integer(HID_T) :: plist_id
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
if (present(mode)) then
m = mode
@ -146,7 +144,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
if (m == 'w') then
call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f (w)')
elseif(m == 'a') then
call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (a)')
@ -154,7 +152,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (r)')
else
call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode')
call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode: '//trim(m))
endif
call h5pclose_f(plist_id, hdferr)
@ -171,7 +169,7 @@ subroutine HDF5_closeFile(fileHandle)
implicit none
integer(HID_T), intent(in) :: fileHandle
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
call h5fclose_f(fileHandle,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeFile: h5fclose_f')
@ -188,7 +186,7 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
integer(HID_T), intent(in) :: fileHandle
character(len=*), intent(in) :: groupName
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: aplist_id
!-------------------------------------------------------------------------------------------------
@ -198,8 +196,10 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
!-------------------------------------------------------------------------------------------------
! setting I/O mode to collective
#ifdef PETSc
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
#endif
!-------------------------------------------------------------------------------------------------
! Create group
@ -219,7 +219,7 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName)
character(len=*), intent(in) :: groupName
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: aplist_id
logical :: is_collective
@ -231,8 +231,10 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName)
!-------------------------------------------------------------------------------------------------
! setting I/O mode to collective
#ifdef PETSc
call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
#endif
!-------------------------------------------------------------------------------------------------
! opening the group
@ -249,7 +251,7 @@ subroutine HDF5_closeGroup(group_id)
implicit none
integer(HID_T), intent(in) :: group_id
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
call h5gclose_f(group_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id,pInt))
@ -265,7 +267,7 @@ logical function HDF5_objectExists(loc_id,path)
implicit none
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in), optional :: path
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
character(len=256) :: p
if (present(path)) then
@ -294,7 +296,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel, attrValue
character(len=*), intent(in), optional :: path
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: attr_id, space_id, type_id
logical :: attrExists
character(len=256) :: p
@ -341,7 +343,7 @@ subroutine HDF5_addAttribute_pInt(loc_id,attrLabel,attrValue,path)
character(len=*), intent(in) :: attrLabel
integer(pInt), intent(in) :: attrValue
character(len=*), intent(in), optional :: path
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: attr_id, space_id, type_id
logical :: attrExists
character(len=256) :: p
@ -388,7 +390,7 @@ subroutine HDF5_addAttribute_pReal(loc_id,attrLabel,attrValue,path)
character(len=*), intent(in) :: attrLabel
real(pReal), intent(in) :: attrValue
character(len=*), intent(in), optional :: path
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: attr_id, space_id, type_id
logical :: attrExists
character(len=256) :: p
@ -434,7 +436,7 @@ subroutine HDF5_setLink(loc_id,target_name,link_name)
implicit none
character(len=*), intent(in) :: target_name, link_name
integer(HID_T), intent(in) :: loc_id
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
logical :: linkExists
call h5lexists_f(loc_id, link_name,linkExists, hdferr)
@ -461,52 +463,11 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(size(shape(dataset))) :: & ! ToDo: Fortran 2018 size(shape(A)) = rank(A)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
localShape = int(shape(dataset),HSIZE_T)
if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty)
!---------------------------------------------------------------------------------------------------
! initialize HDF5 data structures
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, globalShape, loc_id,localShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, globalShape, loc_id,localShape,datasetName,.false.)
endif
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_pReal1
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 2 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel)
implicit none
real(pReal), intent(inout), dimension(:,:) :: dataset
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -528,6 +489,47 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_pReal1
!--------------------------------------------------------------------------------------------------
!> @brief read dataset of type pReal with 2 dimensions
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel)
implicit none
real(pReal), intent(inout), dimension(:,:) :: dataset
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
localShape = int(shape(dataset),HSIZE_T)
if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty)
!---------------------------------------------------------------------------------------------------
! initialize HDF5 data structures
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, globalShape, loc_id,localShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, globalShape, loc_id,localShape,datasetName,.false.)
endif
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f')
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_pReal2
@ -547,7 +549,7 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -588,7 +590,7 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -629,7 +631,7 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -670,7 +672,7 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -711,7 +713,7 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -753,7 +755,7 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -794,7 +796,7 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -835,7 +837,7 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -876,7 +878,7 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -917,7 +919,7 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -958,7 +960,7 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -999,7 +1001,7 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel)
myStart, &
localShape, & !< shape of the dataset (this process)
globalShape !< shape of the dataset (all processes)
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!---------------------------------------------------------------------------------------------------
! determine shape of dataset
@ -1037,7 +1039,7 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1077,7 +1079,7 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1117,7 +1119,7 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1157,7 +1159,7 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1198,7 +1200,7 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1238,7 +1240,7 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1278,7 +1280,7 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1319,7 +1321,7 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1359,7 +1361,7 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1399,7 +1401,7 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1439,7 +1441,7 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1479,7 +1481,7 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1519,7 +1521,7 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1559,7 +1561,7 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel)
logical, intent(in), optional :: parallel
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
myStart, &
@ -1612,7 +1614,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
integer(pInt), dimension(worldsize) :: &
readSize !< contribution of all processes
integer :: ierr
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!-------------------------------------------------------------------------------------------------
! creating a property list for transfer properties (is collective for MPI)
@ -1643,8 +1645,10 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
! creating a property list for IO and set it to collective
call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f')
#ifdef PETSc
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f')
#endif
!--------------------------------------------------------------------------------------------------
! open the dataset in the file and get the space ID
@ -1668,7 +1672,7 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id
implicit none
integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id')
@ -1707,7 +1711,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
integer(pInt), dimension(worldsize) :: &
writeSize !< contribution of all processes
integer :: ierr
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
!-------------------------------------------------------------------------------------------------
! creating a property list for transfer properties
@ -1758,7 +1762,7 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id)
implicit none
integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id
integer(HDF5_ERR_TYPE) :: hdferr
integer :: hdferr
call h5pclose_f(plist_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id')

445
src/IO.f90
View File

@ -21,16 +21,11 @@ module IO
'────────────'
public :: &
IO_init, &
IO_read, &
IO_read_ASCII, &
IO_recursiveRead, &
IO_checkAndRewind, &
IO_open_file_stat, &
IO_open_jobFile_stat, &
IO_open_file, &
IO_open_jobFile_binary, &
IO_write_jobFile, &
IO_write_jobRealFile, &
IO_read_realFile, &
IO_read_intFile, &
IO_isBlank, &
IO_getTag, &
IO_stringPos, &
@ -70,87 +65,99 @@ contains
! ToDo: needed?
!--------------------------------------------------------------------------------------------------
subroutine IO_init
implicit none
write(6,'(/,a)') ' <<<+- IO init -+>>>'
implicit none
write(6,'(/,a)') ' <<<+- IO init -+>>>'
end subroutine IO_init
!--------------------------------------------------------------------------------------------------
!> @brief recursively reads a line from a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
!> @details unstable and buggy
!> @brief reads a line from a text file.
!--------------------------------------------------------------------------------------------------
recursive function IO_read(fileUnit,reset) result(line)
!ToDo: remove recursion once material.config handling is done fully via config module
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
logical, intent(in), optional :: reset
integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units
integer(pInt) :: stack = 1_pInt ! current stack position
character(len=8192), dimension(10) :: pathOn = ''
character(len=512) :: path,input
integer(pInt) :: myStat
character(len=65536) :: line
character(len=*), parameter :: SEP = achar(47)//achar(92) ! forward and backward slash ("/", "\")
!--------------------------------------------------------------------------------------------------
! reset case
if(present(reset)) then; if (reset) then ! do not short circuit here
do while (stack > 1_pInt) ! can go back to former file
close(unitOn(stack))
stack = stack-1_pInt
enddo
return
endif; endif
function IO_read(fileUnit) result(line)
use prec, only: &
pStringLen
implicit none
integer, intent(in) :: fileUnit !< file unit
character(len=pStringLen) :: line
read(fileUnit,'(a256)',END=100) line
100 end function IO_read
!--------------------------------------------------------------------------------------------------
! read from file
unitOn(1) = fileUnit
!> @brief reads an entire ASCII file into an array
!--------------------------------------------------------------------------------------------------
function IO_read_ASCII(fileName) result(fileContent)
use prec, only: &
pStringLen
implicit none
character(len=*), intent(in) :: fileName
read(unitOn(stack),'(a65536)',END=100) line
input = IO_getTag(line,'{','}')
character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
character(len=pStringLen) :: line
character(len=:), allocatable :: rawData
integer :: &
fileLength, &
fileUnit, &
startPos, endPos, &
myTotalLines, & !< # lines read from file
l, &
myStat
logical :: warned
!--------------------------------------------------------------------------------------------------
! read data as stream
inquire(file = fileName, size=fileLength)
if (fileLength == 0) then
allocate(fileContent(0))
return
endif
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0) call IO_error(100,ext_msg=trim(fileName))
allocate(character(len=fileLength)::rawData)
read(fileUnit) rawData
close(fileUnit)
!--------------------------------------------------------------------------------------------------
! normal case
if (input == '') return ! regular line
! count lines to allocate string array
myTotalLines = 1
do l=1, len(rawData)
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
enddo
allocate(fileContent(myTotalLines))
!--------------------------------------------------------------------------------------------------
! recursion case
if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached
! split raw data at end of line
warned = .false.
startPos = 1
l = 1
do while (l <= myTotalLines)
endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2,len(rawData),l /= myTotalLines)
if (endPos - startPos > pStringLen-1) then
line = rawData(startPos:startPos+pStringLen-1)
if (.not. warned) then
call IO_warning(207,ext_msg=trim(fileName),el=l)
warned = .true.
endif
else
line = rawData(startPos:endpos)
endif
startPos = endPos + 2 ! jump to next line start
inquire(UNIT=unitOn(stack),NAME=path) ! path of current file
stack = stack+1_pInt
if(scan(input,SEP) == 1) then ! absolut path given (UNIX only)
pathOn(stack) = input
else
pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir
endif
fileContent(l) = line
l = l + 1
open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack))
enddo
line = IO_read(fileUnit)
return
!--------------------------------------------------------------------------------------------------
! end of file case
100 if (stack > 1_pInt) then ! can go back to former file
close(unitOn(stack))
stack = stack-1_pInt
line = IO_read(fileUnit)
else ! top-most file reached
line = IO_EOF
endif
end function IO_read
end function IO_read_ASCII
!--------------------------------------------------------------------------------------------------
@ -183,6 +190,10 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
!--------------------------------------------------------------------------------------------------
! read data as stream
inquire(file = fileName, size=fileLength)
if (fileLength == 0) then
allocate(fileContent(0))
return
endif
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(fileName))
@ -232,87 +243,77 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
end function IO_recursiveRead
!--------------------------------------------------------------------------------------------------
!> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with
!! error message
!--------------------------------------------------------------------------------------------------
subroutine IO_checkAndRewind(fileUnit)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
logical :: fileOpened
character(len=15) :: fileRead
inquire(unit=fileUnit, opened=fileOpened, read=fileRead)
if (.not. fileOpened .or. trim(fileRead)/='YES') call IO_error(102_pInt)
rewind(fileUnit)
end subroutine IO_checkAndRewind
!--------------------------------------------------------------------------------------------------
!> @brief opens existing file for reading to given unit. Path to file is relative to working
!! directory
!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return
!! value
!--------------------------------------------------------------------------------------------------
subroutine IO_open_file(fileUnit,path)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: path !< relative path from working directory
integer(pInt) :: myStat
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
implicit none
integer, intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: path !< relative path from working directory
integer :: myStat
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path)
end subroutine IO_open_file
!--------------------------------------------------------------------------------------------------
!> @brief opens existing file for reading to given unit. Path to file is relative to working
!! directory
!> @details Like IO_open_file, but error is handled via return value and not via call to IO_error
!> @brief opens an existing file for reading or a new file for writing. Name is the job name
!> @details replaces an existing file when writing
!--------------------------------------------------------------------------------------------------
logical function IO_open_file_stat(fileUnit,path)
!ToDo: DEPRECATED once material.config handling is done fully via config module
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: path !< relative path from working directory
integer function IO_open_jobFile_binary(extension,mode)
use DAMASK_interface, only: &
getSolverJobName
integer(pInt) :: myStat
implicit none
character(len=*), intent(in) :: extension
character, intent(in), optional :: mode
if (present(mode)) then
IO_open_jobFile_binary = IO_open_binary(trim(getSolverJobName())//'.'//trim(extension),mode)
else
IO_open_jobFile_binary = IO_open_binary(trim(getSolverJobName())//'.'//trim(extension))
endif
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) close(fileUnit)
IO_open_file_stat = (myStat == 0_pInt)
end function IO_open_file_stat
end function IO_open_jobFile_binary
!--------------------------------------------------------------------------------------------------
!> @brief opens existing file for reading to given unit. File is named after solver job name
!! plus given extension and located in current working directory
!> @details Like IO_open_jobFile, but error is handled via return value and not via call to
!! IO_error
!> @brief opens an existing file for reading or a new file for writing.
!> @details replaces an existing file when writing
!--------------------------------------------------------------------------------------------------
logical function IO_open_jobFile_stat(fileUnit,ext)
use DAMASK_interface, only: &
getSolverJobName
integer function IO_open_binary(fileName,mode)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext !< extension of file
implicit none
character(len=*), intent(in) :: fileName
character, intent(in), optional :: mode
character :: m
integer :: ierr
integer(pInt) :: myStat
character(len=1024) :: path
if (present(mode)) then
m = mode
else
m = 'r'
endif
path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) close(fileUnit)
IO_open_jobFile_stat = (myStat == 0_pInt)
if (m == 'w') then
open(newunit=IO_open_binary, file=trim(fileName),&
status='replace',access='stream',action='write',iostat=ierr)
if (ierr /= 0) call IO_error(100,ext_msg='could not open file (w): '//trim(fileName))
elseif(m == 'r') then
open(newunit=IO_open_binary, file=trim(fileName),&
status='old', access='stream',action='read', iostat=ierr)
if (ierr /= 0) call IO_error(100,ext_msg='could not open file (r): '//trim(fileName))
else
call IO_error(100,ext_msg='unknown access mode: '//m)
endif
end function IO_open_JobFile_stat
end function IO_open_binary
#if defined(Marc4DAMASK) || defined(Abaqus)
@ -321,7 +322,6 @@ end function IO_open_JobFile_stat
!--------------------------------------------------------------------------------------------------
subroutine IO_open_inputFile(fileUnit,modelName)
use DAMASK_interface, only: &
getSolverJobName, &
inputFileExtension
implicit none
@ -455,92 +455,6 @@ subroutine IO_write_jobFile(fileUnit,ext)
end subroutine IO_write_jobFile
!--------------------------------------------------------------------------------------------------
!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is
!! named after solver job name plus given extension and located in current working directory
!--------------------------------------------------------------------------------------------------
subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
use DAMASK_interface, only: &
getSolverJobName
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext !< extension of file
integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverJobName())//'.'//ext
if (present(recMultiplier)) then
open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path)
else
open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pReal,iostat=myStat,file=path)
endif
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_write_jobRealFile
!--------------------------------------------------------------------------------------------------
!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is
!! located in current working directory
!--------------------------------------------------------------------------------------------------
subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext, & !< extension of file
modelName !< model name, in case of restart not solver job name
integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(modelName)//'.'//ext
if (present(recMultiplier)) then
open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path)
else
open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pReal,iostat=myStat,file=path)
endif
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
end subroutine IO_read_realFile
!--------------------------------------------------------------------------------------------------
!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is
!! located in current working directory
!--------------------------------------------------------------------------------------------------
subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: ext, & !< extension of file
modelName !< model name, in case of restart not solver job name
integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(modelName)//'.'//ext
if (present(recMultiplier)) then
open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pInt*recMultiplier,iostat=myStat,file=path)
else
open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pInt,iostat=myStat,file=path)
endif
if (myStat /= 0) call IO_error(100_pInt,ext_msg=path)
end subroutine IO_read_intFile
!--------------------------------------------------------------------------------------------------
!> @brief identifies strings without content
!--------------------------------------------------------------------------------------------------
@ -1217,7 +1131,6 @@ integer(pInt) function IO_countDataLines(fileUnit)
chunkPos = IO_stringPos(line)
tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt))
if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
else
if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt
@ -1253,7 +1166,6 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit)
if (verify(trim(tmp),'0123456789') == 0) then ! numerical values
IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt
else
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
enddo
@ -1309,18 +1221,15 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit)
line = IO_read(fileUnit)
chunkPos = IO_stringPos(line)
if (chunkPos(1) < 1_pInt) then ! empty line
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator
IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) &
- IO_intValue(line,chunkPos,1_pInt))
line = IO_read(fileUnit, .true.) ! reset IO_read
exit ! only one single range indicator allowed
else
IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c'
if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value
IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt
line = IO_read(fileUnit, .true.) ! reset IO_read
exit ! data ended
endif
endif
@ -1462,27 +1371,27 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
!> @brief returns verified integer value in given string
!--------------------------------------------------------------------------------------------------
integer(pInt) function IO_verifyIntValue (string,validChars,myName)
implicit none
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces!
validChars, & !< valid characters in string
myName !< name of caller function (for debugging)
integer(pInt) :: readStatus, invalidWhere
IO_verifyIntValue = 0_pInt
invalidWhere = verify(string,validChars)
if (invalidWhere == 0_pInt) then
read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found
if (readStatus /= 0_pInt) & ! error during string to integer conversion
call IO_warning(203_pInt,ext_msg=myName//'"'//string//'"')
else
call IO_warning(202_pInt,ext_msg=myName//'"'//string//'"') ! complain about offending characters
read(UNIT=string(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string
if (readStatus /= 0_pInt) & ! error during string to integer conversion
call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"')
endif
implicit none
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces!
validChars, & !< valid characters in string
myName !< name of caller function (for debugging)
integer :: readStatus, invalidWhere
IO_verifyIntValue = 0
invalidWhere = verify(string,validChars)
if (invalidWhere == 0) then
read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found
if (readStatus /= 0) & ! error during string to integer conversion
call IO_warning(203,ext_msg=myName//'"'//string//'"')
else
call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters
read(UNIT=string(1:invalidWhere-1),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string
if (readStatus /= 0) & ! error during string to integer conversion
call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"')
endif
end function IO_verifyIntValue
@ -1490,28 +1399,28 @@ end function IO_verifyIntValue
!> @brief returns verified float value in given string
!--------------------------------------------------------------------------------------------------
real(pReal) function IO_verifyFloatValue (string,validChars,myName)
implicit none
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces!
validChars, & !< valid characters in string
myName !< name of caller function (for debugging)
integer(pInt) :: readStatus, invalidWhere
IO_verifyFloatValue = 0.0_pReal
invalidWhere = verify(string,validChars)
if (invalidWhere == 0_pInt) then
read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyFloatValue ! no offending chars found
if (readStatus /= 0_pInt) & ! error during string to float conversion
call IO_warning(203_pInt,ext_msg=myName//'"'//string//'"')
else
call IO_warning(202_pInt,ext_msg=myName//'"'//string//'"') ! complain about offending characters
read(UNIT=string(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyFloatValue ! interpret remaining string
if (readStatus /= 0_pInt) & ! error during string to float conversion
call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"')
endif
implicit none
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces!
validChars, & !< valid characters in string
myName !< name of caller function (for debugging)
integer :: readStatus, invalidWhere
IO_verifyFloatValue = 0.0_pReal
invalidWhere = verify(string,validChars)
if (invalidWhere == 0) then
read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyFloatValue ! no offending chars found
if (readStatus /= 0) & ! error during string to float conversion
call IO_warning(203,ext_msg=myName//'"'//string//'"')
else
call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters
read(UNIT=string(1:invalidWhere-1),iostat=readStatus,FMT=*) IO_verifyFloatValue ! interpret remaining string
if (readStatus /= 0) & ! error during string to float conversion
call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"')
endif
end function IO_verifyFloatValue
end module IO

10
src/Lambert.f90
View File

@ -164,19 +164,19 @@ pure function LambertBallToCube(xyz) result(cube)
qxy = sum(xyz2**2)
special: if (dEq0(qxy)) then
Tinv = 0.0
Tinv = 0.0_pReal
else special
q2 = qxy + maxval(abs(xyz2))**2
sq2 = sqrt(q2)
q = (beta/R2/R1) * sqrt(q2*qxy/(q2-maxval(abs(xyz2))*sq2))
tt = (minval(abs(xyz2))**2+maxval(abs(xyz2))*sq2)/R2/qxy
Tinv = q * sign(1.0,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12], &
[ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12, 1.0_pReal], &
abs(xyz2(2)) <= abs(xyz2(1)))
Tinv = q * sign(1.0_pReal,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12], &
[ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12, 1.0_pReal], &
abs(xyz2(2)) <= abs(xyz2(1)))
endif special
! inverse M_1
xyz1 = [ Tinv(1), Tinv(2), sign(1.0,xyz3(3)) * rs / pref ] /sc
xyz1 = [ Tinv(1), Tinv(2), sign(1.0_pReal,xyz3(3)) * rs / pref ] /sc
! reverst the coordinates back to the regular order according to the original pyramid number
cube = xyz1(p)

1
src/commercialFEM_fileList.f90
View File

@ -9,6 +9,7 @@
#include "config.f90"
#ifdef DAMASKHDF5
#include "HDF5_utilities.f90"
#include "results.f90"
#endif
#include "math.f90"
#include "quaternions.f90"

71
src/config.f90
View File

@ -17,7 +17,7 @@ module config
integer(pInt), dimension(:), allocatable :: pos
end type tPartitionedString
type, public :: tPartitionedStringList
type, private :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
contains
@ -59,26 +59,11 @@ module config
microstructure_name, & !< name of each microstructure
texture_name !< name of each texture
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part
MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part
MATERIAL_partPhase = 'phase', & !< keyword for phase part
MATERIAL_partMicrostructure = 'microstructure' !< keyword for microstructure part
character(len=*), parameter, private :: &
MATERIAL_partTexture = 'texture' !< keyword for texture part
! ToDo: Remove, use size(config_phase) etc
integer(pInt), public, protected :: &
material_Nphase, & !< number of phases
material_Nhomogenization, & !< number of homogenizations
material_Nmicrostructure, & !< number of microstructures
material_Ncrystallite !< number of crystallite settings
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_configFile = 'material.config', & !< generic name for material configuration file
MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file
material_Nhomogenization !< number of homogenizations
public :: &
config_init, &
@ -90,11 +75,6 @@ contains
!> @brief reads material.config and stores its content per part
!--------------------------------------------------------------------------------------------------
subroutine config_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use DAMASK_interface, only: &
@ -103,9 +83,7 @@ subroutine config_init()
IO_error, &
IO_lc, &
IO_recursiveRead, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
IO_getTag
use debug, only: &
debug_level, &
debug_material, &
@ -121,14 +99,12 @@ subroutine config_init()
logical :: fileExists
write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
myDebug = debug_level(debug_material)
inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists)
inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists)
if(fileExists) then
fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt)
fileContent = IO_recursiveRead(trim(getSolverJobName())//'.materialConfig')
else
inquire(file='material.config',exist=fileExists)
if(.not. fileExists) call IO_error(100_pInt,ext_msg='material.config')
@ -140,39 +116,38 @@ subroutine config_init()
part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part))
case (trim(material_partPhase))
case (trim('phase'))
call parseFile(phase_name,config_phase,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure))
case (trim('microstructure'))
call parseFile(microstructure_name,config_microstructure,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite))
case (trim('crystallite'))
call parseFile(crystallite_name,config_crystallite,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization))
case (trim('homogenization'))
call parseFile(homogenization_name,config_homogenization,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture))
case (trim('texture'))
call parseFile(texture_name,config_texture,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6)
end select
enddo
material_Nhomogenization = size(config_homogenization)
if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization)
material_Nmicrostructure = size(config_microstructure)
if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure)
material_Ncrystallite = size(config_crystallite)
if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite)
material_Nphase = size(config_phase)
if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase)
if (size(config_texture) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture)
material_Nphase = size(config_phase)
if (material_Nhomogenization < 1) call IO_error(160_pInt,ext_msg='<homogenization>')
if (size(config_microstructure) < 1) call IO_error(160_pInt,ext_msg='<microstructure>')
if (size(config_crystallite) < 1) call IO_error(160_pInt,ext_msg='<crystallite>')
if (material_Nphase < 1) call IO_error(160_pInt,ext_msg='<phase>')
if (size(config_texture) < 1) call IO_error(160_pInt,ext_msg='<texture>')
end subroutine config_init

94
src/constitutive.f90
View File

@ -47,14 +47,10 @@ subroutine constitutive_init()
worldrank
use IO, only: &
IO_error, &
IO_open_file, &
IO_open_jobFile_stat, &
IO_write_jobFile
use config, only: &
material_Nphase, &
material_localFileExt, &
phase_name, &
material_configFile, &
config_deallocate
use material, only: &
material_phase, &
@ -482,7 +478,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
end select plasticityType
#ifdef __INTEL_COMPILER
#if defined(__INTEL_COMPILER) || defined(__PGI)
forall(i = 1_pInt:3_pInt, j = 1_pInt:3_pInt)
#else
do concurrent(i = 1_pInt:3_pInt, j = 1_pInt:3_pInt)
@ -490,7 +486,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
dLp_dFi(i,j,1:3,1:3) = math_mul33x33(math_mul33x33(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + &
math_mul33x33(math_mul33x33(Fi,dLp_dMp(i,j,1:3,1:3)),S)
dLp_dS(i,j,1:3,1:3) = math_mul33x33(math_mul33x33(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3)) ! ToDo: @PS: why not: dLp_dMp:(FiT Fi)
#ifdef __INTEL_COMPILER
#if defined(__INTEL_COMPILER) || defined(__PGI)
end forall
#else
enddo
@ -617,7 +613,7 @@ pure function constitutive_initialFi(ipc, ip, el)
math_I3
use material, only: &
material_phase, &
material_homog, &
material_homogenizationAt, &
thermalMapping, &
phase_kinematics, &
phase_Nkinematics, &
@ -645,7 +641,7 @@ pure function constitutive_initialFi(ipc, ip, el)
KinematicsLoop: do k = 1_pInt, phase_Nkinematics(phase) !< Warning: small initial strain assumption
kinematicsType: select case (phase_kinematics(k,phase))
case (KINEMATICS_thermal_expansion_ID) kinematicsType
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
offset = thermalMapping(homog)%p(ip,el)
constitutive_initialFi = &
constitutive_initialFi + kinematics_thermal_expansion_initialStrain(homog,phase,offset)
@ -1106,33 +1102,64 @@ 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
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 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
use material, only: &
phase_plasticityInstance, &
material_phase_plasticity_type => phase_plasticity
use plastic_isotropic, only: &
plastic_isotropic_results
use plastic_phenopowerlaw, only: &
plastic_phenopowerlaw_results
use plastic_kinehardening, only: &
plastic_kinehardening_results
use plastic_dislotwin, only: &
plastic_dislotwin_results
use plastic_disloUCLA, only: &
plastic_disloUCLA_results
use plastic_nonlocal, only: &
plastic_nonlocal_results
implicit none
integer :: 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))))
select case(material_phase_plasticity_type(p))
case(PLASTICITY_ISOTROPIC_ID)
call plastic_isotropic_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
case(PLASTICITY_PHENOPOWERLAW_ID)
call plastic_phenopowerlaw_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
case(PLASTICITY_KINEHARDENING_ID)
call plastic_kinehardening_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
case(PLASTICITY_DISLOTWIN_ID)
call plastic_dislotwin_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
case(PLASTICITY_DISLOUCLA_ID)
call plastic_disloUCLA_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
case(PLASTICITY_NONLOCAL_ID)
call plastic_nonlocal_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
end select
enddo
#endif
@ -1140,4 +1167,5 @@ subroutine constitutive_results()
end subroutine constitutive_results
end module constitutive

87
src/crystallite.f90
View File

@ -38,17 +38,16 @@ module crystallite
crystallite_subdt, & !< substepped time increment of each grain
crystallite_subFrac, & !< already calculated fraction of increment
crystallite_subStep !< size of next integration step
real(pReal), dimension(:,:,:,:), allocatable, public :: &
crystallite_Tstar_v, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) ToDo: Should be called S, 3x3
crystallite_Tstar0_v, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc ToDo: Should be called S, 3x3
crystallite_partionedTstar0_v !< 2nd Piola-Kirchhoff stress vector at start of homog inc ToDo: Should be called S, 3x3
type(rotation), dimension(:,:,:), allocatable, private :: &
type(rotation), dimension(:,:,:), allocatable, private :: &
crystallite_orientation, & !< orientation
crystallite_orientation0 !< initial orientation
real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: &
crystallite_Fe, & !< current "elastic" def grad (end of converged time step)
crystallite_P !< 1st Piola-Kirchhoff stress per grain
real(pReal), dimension(:,:,:,:,:), allocatable, public :: &
crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step)
crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc
crystallite_partionedS0, & !< 2nd Piola-Kirchhoff stress vector at start of homog inc
crystallite_Fp, & !< current plastic def grad (end of converged time step)
crystallite_Fp0, & !< plastic def grad at start of FE inc
crystallite_partionedFp0,& !< plastic def grad at start of homog inc
@ -130,11 +129,6 @@ contains
!> @brief allocates and initialize per grain variables
!--------------------------------------------------------------------------------------------------
subroutine crystallite_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
#ifdef DEBUG
use debug, only: &
debug_info, &
@ -156,7 +150,6 @@ subroutine crystallite_init
theMesh, &
mesh_element
use IO, only: &
IO_timeStamp, &
IO_stringValue, &
IO_write_jobFile, &
IO_error
@ -188,20 +181,14 @@ subroutine crystallite_init
character(len=65536), dimension(:), allocatable :: str
write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
cMax = homogenization_maxNgrains
iMax = theMesh%elem%nIPs
eMax = theMesh%nElems
! ---------------------------------------------------------------------------
! ToDo (when working on homogenization): should be 3x3 tensor called S
allocate(crystallite_Tstar0_v(6,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_partionedTstar0_v(6,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_Tstar_v(6,cMax,iMax,eMax), source=0.0_pReal)
! ---------------------------------------------------------------------------
allocate(crystallite_S0(3,3,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_partionedS0(3,3,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_S(3,3,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_subS0(3,3,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_P(3,3,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_F0(3,3,cMax,iMax,eMax), source=0.0_pReal)
@ -295,7 +282,7 @@ subroutine crystallite_init
crystallite_outputID(o,c) = lp_ID
case ('li') outputName
crystallite_outputID(o,c) = li_ID
case ('p','firstpiola','1stpiola') outputName
case ('p','firstpiola','1stpiola') outputName ! ToDo: no alias (p only)
crystallite_outputID(o,c) = p_ID
case ('s','tstar','secondpiola','2ndpiola') outputName ! ToDo: no alias (s only)
crystallite_outputID(o,c) = s_ID
@ -444,9 +431,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
IO_error
use math, only: &
math_inv33, &
math_mul33x33, &
math_6toSym33, &
math_sym33to6
math_mul33x33
use mesh, only: &
theMesh, &
mesh_element
@ -511,7 +496,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_partionedFi0(1:3,1:3,c,i,e)
crystallite_subLi0(1:3,1:3,c,i,e) = crystallite_partionedLi0(1:3,1:3,c,i,e)
crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partionedF0(1:3,1:3,c,i,e)
crystallite_subS0(1:3,1:3,c,i,e) = math_6toSym33(crystallite_partionedTstar0_v(1:6,c,i,e))
crystallite_subS0(1:3,1:3,c,i,e) = crystallite_partionedS0(1:3,1:3,c,i,e)
crystallite_subFrac(c,i,e) = 0.0_pReal
crystallite_subStep(c,i,e) = 1.0_pReal/subStepSizeCryst
crystallite_todo(c,i,e) = .true.
@ -557,7 +542,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
crystallite_subLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e)
crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e)
crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e)
crystallite_subS0 (1:3,1:3,c,i,e) = math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))
crystallite_subS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e)
!if abbrevation, make c and p private in omp
plasticState( phaseAt(c,i,e))%subState0(:,phasememberAt(c,i,e)) &
= plasticState(phaseAt(c,i,e))%state( :,phasememberAt(c,i,e))
@ -583,7 +568,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
crystallite_invFp(1:3,1:3,c,i,e) = math_inv33(crystallite_Fp (1:3,1:3,c,i,e))
crystallite_Fi (1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e)
crystallite_invFi(1:3,1:3,c,i,e) = math_inv33(crystallite_Fi (1:3,1:3,c,i,e))
crystallite_Tstar_v(1:6,c,i,e) = math_sym33to6(crystallite_subS0(1:3,1:3,c,i,e))
crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e)
if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback
crystallite_Lp (1:3,1:3,c,i,e) = crystallite_subLp0(1:3,1:3,c,i,e)
crystallite_Li (1:3,1:3,c,i,e) = crystallite_subLi0(1:3,1:3,c,i,e)
@ -707,7 +692,6 @@ subroutine crystallite_stressTangent()
math_inv33, &
math_identity2nd, &
math_mul33x33, &
math_6toSym33, &
math_3333to99, &
math_99to3333, &
math_I3, &
@ -758,7 +742,7 @@ subroutine crystallite_stressTangent()
crystallite_Fe(1:3,1:3,c,i,e), &
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate elastic stress tangent
call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, &
math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), &
crystallite_S (1:3,1:3,c,i,e), &
crystallite_Fi(1:3,1:3,c,i,e), &
c,i,e) ! call constitutive law to calculate Li tangent in lattice configuration
@ -787,7 +771,7 @@ subroutine crystallite_stressTangent()
endif
call constitutive_LpAndItsTangents(devNull,dLpdS,dLpdFi, &
math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), &
crystallite_S (1:3,1:3,c,i,e), &
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration
dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS
@ -832,15 +816,15 @@ subroutine crystallite_stressTangent()
!--------------------------------------------------------------------------------------------------
! assemble dPdF
temp_33_1 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), &
math_mul33x33(crystallite_S(1:3,1:3,c,i,e), &
transpose(crystallite_invFp(1:3,1:3,c,i,e))))
temp_33_2 = math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), &
temp_33_2 = math_mul33x33(crystallite_S(1:3,1:3,c,i,e), &
transpose(crystallite_invFp(1:3,1:3,c,i,e)))
temp_33_3 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
crystallite_invFp(1:3,1:3,c,i,e))
temp_33_4 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
crystallite_invFp(1:3,1:3,c,i,e)), &
math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)))
crystallite_S(1:3,1:3,c,i,e))
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal
do p=1_pInt, 3_pInt
@ -943,8 +927,7 @@ function crystallite_postResults(ipc, ip, el)
math_mul33x33, &
math_det33, &
math_I3, &
inDeg, &
math_6toSym33
inDeg
use mesh, only: &
theMesh, &
mesh_element, &
@ -1048,7 +1031,7 @@ function crystallite_postResults(ipc, ip, el)
case (s_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)),[mySize])
reshape(crystallite_S(1:3,1:3,ipc,ip,el),[mySize])
case (elasmatrix_ID)
mySize = 36_pInt
crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize])
@ -1070,7 +1053,7 @@ function crystallite_postResults(ipc, ip, el)
c = c + 1_pInt
if (size(crystallite_postResults)-c > 0_pInt) &
crystallite_postResults(c+1:size(crystallite_postResults)) = &
constitutive_postResults(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)), crystallite_Fi(1:3,1:3,ipc,ip,el), &
constitutive_postResults(crystallite_S(1:3,1:3,ipc,ip,el), crystallite_Fi(1:3,1:3,ipc,ip,el), &
ipc, ip, el)
end function crystallite_postResults
@ -1111,13 +1094,15 @@ logical function integrateStress(&
constitutive_LiAndItsTangents, &
constitutive_SandItsTangents
use math, only: math_mul33x33, &
#ifdef __PGI
norm2, &
#endif
math_mul33xx33, &
math_mul3333xx3333, &
math_inv33, &
math_det33, &
math_I3, &
math_identity2nd, &
math_sym33to6, &
math_3333to99, &
math_33to9, &
math_9to33
@ -1487,7 +1472,7 @@ logical function integrateStress(&
integrateStress = .true.
crystallite_P (1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), &
math_mul33x33(S,transpose(invFp_new)))
crystallite_Tstar_v (1:6,ipc,ip,el) = math_sym33to6(S)
crystallite_S (1:3,1:3,ipc,ip,el) = S
crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess
crystallite_Li (1:3,1:3,ipc,ip,el) = Liguess
crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new
@ -2279,8 +2264,6 @@ end subroutine update_state
subroutine update_dotState(timeFraction)
use, intrinsic :: &
IEEE_arithmetic
use math, only: &
math_6toSym33 !ToDo: Temporarly needed until T_star_v is called S and stored as matrix
use material, only: &
plasticState, &
sourceState, &
@ -2313,7 +2296,7 @@ subroutine update_dotState(timeFraction)
do g = 1,homogenization_Ngrains(mesh_element(3,e))
!$OMP FLUSH(nonlocalStop)
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
call constitutive_collectDotState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), &
call constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), &
crystallite_Fe, &
crystallite_Fi(1:3,1:3,g,i,e), &
crystallite_Fp, &
@ -2350,8 +2333,6 @@ subroutine update_deltaState
phaseAt, phasememberAt
use constitutive, only: &
constitutive_collectDeltaState
use math, only: &
math_6toSym33
implicit none
integer(pInt) :: &
e, & !< element index in element loop
@ -2374,10 +2355,10 @@ subroutine update_deltaState
do g = 1,homogenization_Ngrains(mesh_element(3,e))
!$OMP FLUSH(nonlocalStop)
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), &
crystallite_Fe(1:3,1:3,g,i,e), &
crystallite_Fi(1:3,1:3,g,i,e), &
g,i,e)
call constitutive_collectDeltaState(crystallite_S(1:3,1:3,g,i,e), &
crystallite_Fe(1:3,1:3,g,i,e), &
crystallite_Fi(1:3,1:3,g,i,e), &
g,i,e)
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
myOffset = plasticState(p)%offsetDeltaState
mySize = plasticState(p)%sizeDeltaState
@ -2440,8 +2421,6 @@ logical function stateJump(ipc,ip,el)
mesh_element
use constitutive, only: &
constitutive_collectDeltaState
use math, only: &
math_6toSym33
implicit none
integer(pInt), intent(in):: &
@ -2459,10 +2438,10 @@ logical function stateJump(ipc,ip,el)
c = phasememberAt(ipc,ip,el)
p = phaseAt(ipc,ip,el)
call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)), &
crystallite_Fe(1:3,1:3,ipc,ip,el), &
crystallite_Fi(1:3,1:3,ipc,ip,el), &
ipc,ip,el)
call constitutive_collectDeltaState(crystallite_S(1:3,1:3,ipc,ip,el), &
crystallite_Fe(1:3,1:3,ipc,ip,el), &
crystallite_Fi(1:3,1:3,ipc,ip,el), &
ipc,ip,el)
myOffset = plasticState(p)%offsetDeltaState
mySize = plasticState(p)%sizeDeltaState

171
src/damage_local.f90
View File

@ -9,9 +9,6 @@ module damage_local
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
damage_local_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
damage_local_sizePostResult !< size of each post result output
@ -27,7 +24,15 @@ module damage_local
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
damage_local_outputID !< ID of each post result output
type, private :: tParameters
integer(kind(undefined_ID)), dimension(:), allocatable :: &
outputID
end type tParameters
type(tparameters), dimension(:), allocatable, private :: &
param
public :: &
damage_local_init, &
damage_local_updateState, &
@ -38,128 +43,82 @@ module damage_local
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine damage_local_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
subroutine damage_local_init
use material, only: &
damage_type, &
damage_typeInstance, &
homogenization_Noutput, &
DAMAGE_local_label, &
DAMAGE_local_ID, &
material_homog, &
material_homogenizationAt, &
mappingHomogenization, &
damageState, &
damageMapping, &
damage, &
damage_initialPhi
use config, only: &
material_partHomogenization
config_homogenization
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,homog,instance,o
integer(pInt) :: maxNinstance,homog,instance,o,i
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: NofMyHomog, h
integer(kind(undefined_ID)) :: &
outputID
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(damage_local_sizePostResults(maxNinstance), source=0_pInt)
allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance))
damage_local_output = ''
allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(damage_local_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
homog = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next homog section
homog = homog + 1_pInt ! advance homog section counter
cycle ! skip to next line
endif
allocate(param(maxNinstance))
do h = 1, size(damage_type)
if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle
associate(prm => param(damage_typeInstance(h)), &
config => config_homogenization(h))
if (homog > 0_pInt ) then; if (damage_type(homog) == DAMAGE_local_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = damage_typeInstance(homog) ! which instance of my damage is present homog
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('damage')
damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1_pInt
damage_local_outputID(damage_local_Noutput(instance),instance) = damage_ID
damage_local_output(damage_local_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
end select
endif; endif
enddo parsingFile
initializeInstances: do homog = 1_pInt, size(damage_type)
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
myhomog: if (damage_type(homog) == DAMAGE_local_ID) then
NofMyHomog = count(material_homog == homog)
do i=1, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('damage')
damage_local_output(i,damage_typeInstance(h)) = outputs(i)
damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1
damage_local_sizePostResult(i,damage_typeInstance(h)) = 1
prm%outputID = [prm%outputID , damage_ID]
end select
enddo
homog = h
NofMyHomog = count(material_homogenizationAt == homog)
instance = damage_typeInstance(homog)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,damage_local_Noutput(instance)
select case(damage_local_outputID(o,instance))
case(damage_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
damage_local_sizePostResult(o,instance) = mySize
damage_local_sizePostResults(instance) = damage_local_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! allocate state arrays
sizeState = 1_pInt
damageState(homog)%sizeState = sizeState
damageState(homog)%sizePostResults = damage_local_sizePostResults(instance)
damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance))
allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog))
allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog))
allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog))
@ -169,8 +128,8 @@ subroutine damage_local_init(fileUnit)
deallocate(damage(homog)%p)
damage(homog)%p => damageState(homog)%state(1,:)
endif myhomog
enddo initializeInstances
end associate
enddo
end subroutine damage_local_init
@ -184,6 +143,7 @@ function damage_local_updateState(subdt, ip, el)
err_damage_tolAbs, &
err_damage_tolRel
use material, only: &
material_homogenizationAt, &
mappingHomogenization, &
damageState
@ -193,7 +153,7 @@ function damage_local_updateState(subdt, ip, el)
el !< element number
real(pReal), intent(in) :: &
subdt
logical, dimension(2) :: &
logical, dimension(2) :: &
damage_local_updateState
integer(pInt) :: &
homog, &
@ -201,7 +161,7 @@ function damage_local_updateState(subdt, ip, el)
real(pReal) :: &
phi, phiDot, dPhiDot_dPhi
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
offset = mappingHomogenization(1,ip,el)
phi = damageState(homog)%subState0(1,offset)
call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
@ -223,7 +183,7 @@ end function damage_local_updateState
subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
use material, only: &
homogenization_Ngrains, &
mappingHomogenization, &
material_homogenizationAt, &
phaseAt, &
phasememberAt, &
phase_source, &
@ -257,7 +217,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
phiDot = 0.0_pReal
dPhiDot_dPhi = 0.0_pReal
do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
phase = phaseAt(grain,ip,el)
constituent = phasememberAt(grain,ip,el)
do source = 1, phase_Nsources(phase)
@ -284,8 +244,8 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
enddo
enddo
phiDot = phiDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end subroutine damage_local_getSourceAndItsTangent
@ -294,7 +254,7 @@ end subroutine damage_local_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
function damage_local_postResults(ip,el)
use material, only: &
mappingHomogenization, &
material_homogenizationAt, &
damage_typeInstance, &
damageMapping, &
damage
@ -303,27 +263,28 @@ function damage_local_postResults(ip,el)
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(damage_local_sizePostResults(damage_typeInstance(mappingHomogenization(2,ip,el)))) :: &
real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
damage_local_postResults
integer(pInt) :: &
instance, homog, offset, o, c
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
offset = damageMapping(homog)%p(ip,el)
instance = damage_typeInstance(homog)
associate(prm => param(instance))
c = 0_pInt
damage_local_postResults = 0.0_pReal
do o = 1_pInt,damage_local_Noutput(instance)
select case(damage_local_outputID(o,instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
case (damage_ID)
damage_local_postResults(c+1_pInt) = damage(homog)%p(offset)
c = c + 1
end select
enddo
enddo outputsLoop
end associate
end function damage_local_postResults
end module damage_local

74
src/damage_none.f90
View File

@ -4,11 +4,11 @@
!--------------------------------------------------------------------------------------------------
module damage_none
implicit none
private
public :: &
damage_none_init
implicit none
private
public :: &
damage_none_init
contains
@ -16,43 +16,39 @@ contains
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine damage_none_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pInt
use IO, only: &
IO_timeStamp
use material
use config
use config, only: &
config_homogenization
use material, only: &
damage_initialPhi, &
damage, &
damage_type, &
material_homogenizationAt, &
damageState, &
DAMAGE_NONE_LABEL, &
DAMAGE_NONE_ID
implicit none
integer(pInt) :: &
homog, &
NofMyHomog
implicit none
integer :: &
homog, &
NofMyHomog
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (damage_type(homog) == DAMAGE_none_ID) then
NofMyHomog = count(material_homog == homog)
damageState(homog)%sizeState = 0_pInt
damageState(homog)%sizePostResults = 0_pInt
allocate(damageState(homog)%state0 (0_pInt,NofMyHomog))
allocate(damageState(homog)%subState0(0_pInt,NofMyHomog))
allocate(damageState(homog)%state (0_pInt,NofMyHomog))
deallocate(damage(homog)%p)
allocate (damage(homog)%p(1), source=damage_initialPhi(homog))
endif myhomog
enddo initializeInstances
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_NONE_LABEL//' init -+>>>'
initializeInstances: do homog = 1, size(config_homogenization)
myhomog: if (damage_type(homog) == DAMAGE_NONE_ID) then
NofMyHomog = count(material_homogenizationAt == homog)
damageState(homog)%sizeState = 0
damageState(homog)%sizePostResults = 0
allocate(damageState(homog)%state0 (0,NofMyHomog))
allocate(damageState(homog)%subState0(0,NofMyHomog))
allocate(damageState(homog)%state (0,NofMyHomog))
deallocate(damage(homog)%p)
allocate (damage(homog)%p(1), source=damage_initialPhi(homog))
endif myhomog
enddo initializeInstances
end subroutine damage_none_init

194
src/damage_nonlocal.f90
View File

@ -10,9 +10,6 @@ module damage_nonlocal
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
damage_nonlocal_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
damage_nonlocal_sizePostResult !< size of each post result output
@ -26,9 +23,14 @@ module damage_nonlocal
enumerator :: undefined_ID, &
damage_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
damage_nonlocal_outputID !< ID of each post result output
type, private :: tParameters
integer(kind(undefined_ID)), dimension(:), allocatable :: &
outputID
end type tParameters
type(tparameters), dimension(:), allocatable, private :: &
param
public :: &
damage_nonlocal_init, &
@ -40,142 +42,92 @@ module damage_nonlocal
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine damage_nonlocal_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
subroutine damage_nonlocal_init
use material, only: &
damage_type, &
damage_typeInstance, &
homogenization_Noutput, &
DAMAGE_nonlocal_label, &
DAMAGE_nonlocal_ID, &
material_homog, &
material_homogenizationAt, &
mappingHomogenization, &
damageState, &
damageMapping, &
damage, &
damage_initialPhi
use config, only: &
material_partHomogenization
config_homogenization
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
integer(pInt) :: maxNinstance,homog,instance,o,i
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: NofMyHomog, h
integer(kind(undefined_ID)) :: &
outputID
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt)
if (maxNinstance == 0_pInt) return
allocate(damage_nonlocal_sizePostResults(maxNinstance), source=0_pInt)
allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance))
damage_nonlocal_output = ''
allocate(damage_nonlocal_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
allocate(damage_nonlocal_Noutput (maxNinstance), source=0_pInt)
rewind(fileUnit)
section = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next homog section
section = section + 1_pInt ! advance homog section counter
cycle ! skip to next line
endif
if (section > 0_pInt ) then; if (damage_type(section) == DAMAGE_nonlocal_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = damage_typeInstance(section) ! which instance of my damage is present homog
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
allocate(param(maxNinstance))
do h = 1, size(damage_type)
if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle
associate(prm => param(damage_typeInstance(h)), &
config => config_homogenization(h))
instance = damage_typeInstance(h)
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('damage')
damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1_pInt
damage_nonlocal_outputID(damage_nonlocal_Noutput(instance),instance) = damage_ID
damage_nonlocal_output(damage_nonlocal_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i)
damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1
damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1
prm%outputID = [prm%outputID , damage_ID]
end select
enddo
end select
endif; endif
enddo parsingFile
initializeInstances: do section = 1_pInt, size(damage_type)
if (damage_type(section) == DAMAGE_nonlocal_ID) then
NofMyHomog=count(material_homog==section)
instance = damage_typeInstance(section)
homog = h
NofMyHomog = count(material_homogenizationAt == homog)
instance = damage_typeInstance(homog)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,damage_nonlocal_Noutput(instance)
select case(damage_nonlocal_outputID(o,instance))
case(damage_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
damage_nonlocal_sizePostResult(o,instance) = mySize
damage_nonlocal_sizePostResults(instance) = damage_nonlocal_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! allocate state arrays
sizeState = 0_pInt
damageState(section)%sizeState = sizeState
damageState(section)%sizePostResults = damage_nonlocal_sizePostResults(instance)
allocate(damageState(section)%state0 (sizeState,NofMyHomog))
allocate(damageState(section)%subState0(sizeState,NofMyHomog))
allocate(damageState(section)%state (sizeState,NofMyHomog))
sizeState = 1_pInt
damageState(homog)%sizeState = sizeState
damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance))
allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog))
allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog))
allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog))
nullify(damageMapping(section)%p)
damageMapping(section)%p => mappingHomogenization(1,:,:)
deallocate(damage(section)%p)
allocate(damage(section)%p(NofMyHomog), source=damage_initialPhi(section))
nullify(damageMapping(homog)%p)
damageMapping(homog)%p => mappingHomogenization(1,:,:)
deallocate(damage(homog)%p)
damage(homog)%p => damageState(homog)%state(1,:)
endif
enddo initializeInstances
end associate
enddo
end subroutine damage_nonlocal_init
!--------------------------------------------------------------------------------------------------
@ -184,7 +136,7 @@ end subroutine damage_nonlocal_init
subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
use material, only: &
homogenization_Ngrains, &
mappingHomogenization, &
material_homogenizationAt, &
phaseAt, &
phasememberAt, &
phase_source, &
@ -218,10 +170,10 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
phiDot = 0.0_pReal
dPhiDot_dPhi = 0.0_pReal
do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
phase = phaseAt(grain,ip,el)
constituent = phasememberAt(grain,ip,el)
do source = 1_pInt, phase_Nsources(phase)
do source = 1, phase_Nsources(phase)
select case(phase_source(source,phase))
case (SOURCE_damage_isoBrittle_ID)
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
@ -245,8 +197,8 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
enddo
enddo
phiDot = phiDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end subroutine damage_nonlocal_getSourceAndItsTangent
@ -261,7 +213,7 @@ function damage_nonlocal_getDiffusion33(ip,el)
use material, only: &
homogenization_Ngrains, &
material_phase, &
mappingHomogenization
material_homogenizationAt
use crystallite, only: &
crystallite_push33ToRef
@ -275,7 +227,7 @@ function damage_nonlocal_getDiffusion33(ip,el)
homog, &
grain
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
damage_nonlocal_getDiffusion33 = 0.0_pReal
do grain = 1, homogenization_Ngrains(homog)
damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + &
@ -322,7 +274,7 @@ end function damage_nonlocal_getMobility
!--------------------------------------------------------------------------------------------------
subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el)
use material, only: &
material_homog, &
material_homogenizationAt, &
damageMapping, &
damage
@ -336,7 +288,7 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el)
homog, &
offset
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
offset = damageMapping(homog)%p(ip,el)
damage(homog)%p(offset) = phi
@ -347,35 +299,37 @@ end subroutine damage_nonlocal_putNonLocalDamage
!--------------------------------------------------------------------------------------------------
function damage_nonlocal_postResults(ip,el)
use material, only: &
mappingHomogenization, &
material_homogenizationAt, &
damage_typeInstance, &
damageMapping, &
damage
implicit none
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(damage_nonlocal_sizePostResults(damage_typeInstance(mappingHomogenization(2,ip,el)))) :: &
real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
damage_nonlocal_postResults
integer(pInt) :: &
instance, homog, offset, o, c
homog = mappingHomogenization(2,ip,el)
offset = mappingHomogenization(1,ip,el)
homog = material_homogenizationAt(el)
offset = damageMapping(homog)%p(ip,el)
instance = damage_typeInstance(homog)
associate(prm => param(instance))
c = 0_pInt
damage_nonlocal_postResults = 0.0_pReal
do o = 1_pInt,damage_nonlocal_Noutput(instance)
select case(damage_nonlocal_outputID(o,instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
case (damage_ID)
damage_nonlocal_postResults(c+1_pInt) = damage(homog)%p(offset)
c = c + 1
end select
enddo
enddo outputsLoop
end associate
end function damage_nonlocal_postResults
end module damage_nonlocal

42
src/debug.f90
View File

@ -63,9 +63,6 @@ module debug
debug_jacobianMax = -huge(1.0_pReal), &
debug_jacobianMin = huge(1.0_pReal)
character(len=64), parameter, private :: &
debug_CONFIGFILE = 'debug.config' !< name of configuration file
#ifdef PETSc
character(len=1024), parameter, public :: &
PETSCDEBUG = ' -snes_view -snes_monitor '
@ -81,46 +78,38 @@ contains
!> @brief reads in parameters from debug.config and allocates arrays
!--------------------------------------------------------------------------------------------------
subroutine debug_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use IO, only: &
IO_read, &
IO_read_ASCII, &
IO_error, &
IO_open_file_stat, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_lc, &
IO_floatValue, &
IO_intValue, &
IO_timeStamp, &
IO_EOF
IO_intValue
implicit none
integer(pInt), parameter :: FILEUNIT = 330_pInt
character(len=pStringLen), dimension(:), allocatable :: fileContent
integer(pInt) :: i, what
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: tag, line
integer :: i, what, j
integer, allocatable, dimension(:) :: chunkPos
character(len=pStringLen) :: tag, line
logical :: fexist
write(6,'(/,a)') ' <<<+- debug init -+>>>'
#ifdef DEBUG
write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m'
#endif
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! try to open the config file
line = ''
fileExists: if(IO_open_file_stat(FILEUNIT,debug_configFile)) then
do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(FILEUNIT)
inquire(file='debug.config', exist=fexist)
fileExists: if (fexist) then
fileContent = IO_read_ASCII('debug.config')
do j=1, size(fileContent)
line = fileContent(j)
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
@ -189,7 +178,6 @@ subroutine debug_init
enddo
endif
enddo
close(FILEUNIT)
do i = 1_pInt, debug_maxNtype
if (debug_level(i) == 0) &

1649
src/element.f90
View File

File diff suppressed because it is too large Load Diff

121
src/homogenization.f90
View File

@ -57,11 +57,6 @@ contains
!> @brief module initialization
!--------------------------------------------------------------------------------------------------
subroutine homogenization_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use math, only: &
math_I3
use debug, only: &
@ -79,8 +74,6 @@ subroutine homogenization_init
use crystallite, only: &
crystallite_maxSizePostResults
use config, only: &
material_configFile, &
material_localFileExt, &
config_deallocate, &
config_homogenization, &
homogenization_name
@ -116,23 +109,16 @@ subroutine homogenization_init
if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init
if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init
!--------------------------------------------------------------------------------------------------
! open material.config
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file
if (any(damage_type == DAMAGE_none_ID)) &
call damage_none_init()
if (any(damage_type == DAMAGE_local_ID)) &
call damage_local_init(FILEUNIT)
if (any(damage_type == DAMAGE_nonlocal_ID)) &
call damage_nonlocal_init(FILEUNIT)
if (any(damage_type == DAMAGE_none_ID)) call damage_none_init
if (any(damage_type == DAMAGE_local_ID)) call damage_local_init
if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init
!--------------------------------------------------------------------------------------------------
! write description file for homogenization output
mainProcess2: if (worldrank == 0) then
call IO_write_jobFile(FILEUNIT,'outputHomogenization')
do p = 1,size(config_homogenization)
if (any(material_homog == p)) then
if (any(material_homogenizationAt == p)) then
i = homogenization_typeInstance(p) ! which instance of this homogenization type
valid = .true. ! assume valid
select case(homogenization_type(p)) ! split per homogenization type
@ -265,8 +251,6 @@ subroutine homogenization_init
allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems))
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then
#ifdef TODO
@ -318,6 +302,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
thermalState, &
damageState, &
phase_Nsources, &
material_homogenizationAt, &
mappingHomogenization, &
phaseAt, phasememberAt, &
homogenization_Ngrains
@ -331,15 +316,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_Tstar0_v, &
crystallite_Tstar_v, &
crystallite_S0, &
crystallite_S, &
crystallite_partionedF0, &
crystallite_partionedF, &
crystallite_partionedFp0, &
crystallite_partionedLp0, &
crystallite_partionedFi0, &
crystallite_partionedLi0, &
crystallite_partionedTstar0_v, &
crystallite_partionedS0, &
crystallite_dt, &
crystallite_requested, &
crystallite_stress, &
@ -396,8 +381,8 @@ 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_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
crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) ! ...def grads
crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) ! ...2nd PK stress
enddo; enddo
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e))
@ -408,17 +393,17 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
materialpoint_requested(i,e) = .true. ! everybody requires calculation
endforall
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
homogState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state
homogState(material_homogenizationAt(e))%sizeState > 0_pInt) &
homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
thermalState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state
thermalState(material_homogenizationAt(e))%sizeState > 0_pInt) &
thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
damageState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state
damageState(material_homogenizationAt(e))%sizeState > 0_pInt) &
damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state
enddo
NiterationHomog = 0_pInt
@ -465,8 +450,8 @@ 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_partionedTstar0_v(1:6,1:myNgrains,i,e) = &
crystallite_Tstar_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress
crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_S(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress
do g = 1,myNgrains
plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = &
@ -478,17 +463,17 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
enddo
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
homogState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state
homogState(material_homogenizationAt(e))%sizeState > 0_pInt) &
homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
thermalState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal thermal state
thermalState(material_homogenizationAt(e))%sizeState > 0_pInt) &
thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal thermal state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state
damageState(material_homogenizationAt(e))%sizeState > 0_pInt) &
damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state
materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad
endif steppingNeeded
@ -528,8 +513,8 @@ 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_Tstar_v(1:6,1:myNgrains,i,e) = &
crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress
crystallite_S(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress
do g = 1, myNgrains
plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) = &
plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e))
@ -539,17 +524,17 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
enddo
enddo
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
homogState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
homogState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = &
homogState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal homogenization state
homogState(material_homogenizationAt(e))%sizeState > 0_pInt) &
homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = &
homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal homogenization state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
thermalState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
thermalState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = &
thermalState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state
thermalState(material_homogenizationAt(e))%sizeState > 0_pInt) &
thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = &
thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = &
damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state
damageState(material_homogenizationAt(e))%sizeState > 0_pInt) &
damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = &
damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state
endif
endif converged
@ -653,7 +638,7 @@ subroutine materialpoint_postResults
use mesh, only: &
mesh_element
use material, only: &
mappingHomogenization, &
material_homogenizationAt, &
homogState, &
thermalState, &
damageState, &
@ -683,9 +668,9 @@ subroutine materialpoint_postResults
IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
thePos = 0_pInt
theSize = homogState (mappingHomogenization(2,i,e))%sizePostResults &
+ thermalState (mappingHomogenization(2,i,e))%sizePostResults &
+ damageState (mappingHomogenization(2,i,e))%sizePostResults
theSize = homogState (material_homogenizationAt(e))%sizePostResults &
+ thermalState (material_homogenizationAt(e))%sizePostResults &
+ damageState (material_homogenizationAt(e))%sizePostResults
materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results
thePos = thePos + 1_pInt
@ -918,9 +903,9 @@ function postResults(ip,el)
integer(pInt), intent(in) :: &
ip, & !< integration point
el !< element number
real(pReal), dimension( homogState (mappingHomogenization(2,ip,el))%sizePostResults &
+ thermalState (mappingHomogenization(2,ip,el))%sizePostResults &
+ damageState (mappingHomogenization(2,ip,el))%sizePostResults) :: &
real(pReal), dimension( homogState (material_homogenizationAt(el))%sizePostResults &
+ thermalState (material_homogenizationAt(el))%sizePostResults &
+ damageState (material_homogenizationAt(el))%sizePostResults) :: &
postResults
integer(pInt) :: &
startPos, endPos ,&
@ -929,7 +914,7 @@ function postResults(ip,el)
postResults = 0.0_pReal
startPos = 1_pInt
endPos = homogState(mappingHomogenization(2,ip,el))%sizePostResults
endPos = homogState(material_homogenizationAt(el))%sizePostResults
chosenHomogenization: select case (homogenization_type(mesh_element(3,el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
@ -940,22 +925,22 @@ function postResults(ip,el)
end select chosenHomogenization
startPos = endPos + 1_pInt
endPos = endPos + thermalState(mappingHomogenization(2,ip,el))%sizePostResults
endPos = endPos + thermalState(material_homogenizationAt(el))%sizePostResults
chosenThermal: select case (thermal_type(mesh_element(3,el)))
case (THERMAL_adiabatic_ID) chosenThermal
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
postResults(startPos:endPos) = &
thermal_adiabatic_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el))
case (THERMAL_conduction_ID) chosenThermal
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
postResults(startPos:endPos) = &
thermal_conduction_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el))
end select chosenThermal
startPos = endPos + 1_pInt
endPos = endPos + damageState(mappingHomogenization(2,ip,el))%sizePostResults
endPos = endPos + damageState(material_homogenizationAt(el))%sizePostResults
chosenDamage: select case (damage_type(mesh_element(3,el)))
case (DAMAGE_local_ID) chosenDamage

31
src/homogenization_RGC.f90
View File

@ -42,7 +42,7 @@ module homogenization_RGC
of_debug = 0_pInt
integer(kind(undefined_ID)), dimension(:), allocatable :: &
outputID
end type
end type tParameters
type, private :: tRGCstate
real(pReal), pointer, dimension(:) :: &
@ -92,11 +92,6 @@ contains
!> @brief allocates all necessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_RGC_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
#ifdef DEBUG
debug_i, &
@ -109,15 +104,13 @@ subroutine homogenization_RGC_init()
math_EulerToR, &
INRAD
use IO, only: &
IO_error, &
IO_timeStamp
IO_error
use material, only: &
#ifdef DEBUG
material_homogenizationAt, &
mappingHomogenization, &
#endif
homogenization_type, &
material_homog, &
material_homogenizationAt, &
homogState, &
HOMOGENIZATION_RGC_ID, &
HOMOGENIZATION_RGC_LABEL, &
@ -143,15 +136,15 @@ subroutine homogenization_RGC_init()
outputs
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>'
write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming, 2(1):939–942, 2009'
write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1'
write(6,'(/,a)') ' Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010'
write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
Ninstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) &
write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009'
write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1'
write(6,'(/,a)') ' Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering 18:015006, 2010'
write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006'
Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(param(Ninstance))
@ -223,7 +216,7 @@ subroutine homogenization_RGC_init()
enddo
NofMyHomog = count(material_homog == h)
NofMyHomog = count(material_homogenizationAt == h)
nIntFaceTot = 3_pInt*( (prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)*prm%Nconstituents(3) &
+ prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3) &
+ prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1_pInt))

12
src/homogenization_isostrain.f90
View File

@ -36,21 +36,15 @@ contains
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_isostrain_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_HOMOGENIZATION, &
debug_level, &
debug_levelBasic
use IO, only: &
IO_timeStamp, &
IO_error
use material, only: &
homogenization_type, &
material_homog, &
material_homogenizationAt, &
homogState, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_ISOSTRAIN_LABEL, &
@ -67,8 +61,6 @@ subroutine homogenization_isostrain_init()
tag = ''
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
Ninstance = int(count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID),pInt)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) &
@ -93,7 +85,7 @@ subroutine homogenization_isostrain_init()
call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')')
end select
NofMyHomog = count(material_homog == h)
NofMyHomog = count(material_homogenizationAt == h)
homogState(h)%sizeState = 0_pInt
homogState(h)%sizePostResults = 0_pInt
allocate(homogState(h)%state0 (0_pInt,NofMyHomog))

92
src/homogenization_none.f90
View File

@ -6,11 +6,11 @@
!--------------------------------------------------------------------------------------------------
module homogenization_none
implicit none
private
public :: &
homogenization_none_init
implicit none
private
public :: &
homogenization_none_init
contains
@ -18,52 +18,42 @@ contains
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_none_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pInt
use debug, only: &
debug_HOMOGENIZATION, &
debug_level, &
debug_levelBasic
use IO, only: &
IO_timeStamp
use material, only: &
homogenization_type, &
material_homog, &
homogState, &
HOMOGENIZATION_NONE_LABEL, &
HOMOGENIZATION_NONE_ID
implicit none
integer(pInt) :: &
Ninstance, &
h, &
NofMyHomog
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
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
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
use debug, only: &
debug_HOMOGENIZATION, &
debug_level, &
debug_levelBasic
use config, only: &
config_homogenization
use material, only: &
homogenization_type, &
material_homogenizationAt, &
homogState, &
HOMOGENIZATION_NONE_LABEL, &
HOMOGENIZATION_NONE_ID
implicit none
integer :: &
Ninstance, &
h, &
NofMyHomog
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'
Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
do h = 1, size(homogenization_type)
if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle
NofMyHomog = count(material_homogenizationAt == h)
homogState(h)%sizeState = 0
homogState(h)%sizePostResults = 0
allocate(homogState(h)%state0 (0,NofMyHomog))
allocate(homogState(h)%subState0(0,NofMyHomog))
allocate(homogState(h)%state (0,NofMyHomog))
enddo
end subroutine homogenization_none_init

15
src/kinematics_cleavage_opening.f90
View File

@ -54,11 +54,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_cleavage_opening_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_level,&
debug_constitutive,&
@ -66,9 +61,7 @@ subroutine kinematics_cleavage_opening_init()
use config, only: &
config_phase
use IO, only: &
IO_warning, &
IO_error, &
IO_timeStamp
IO_error
use material, only: &
phase_kinematics, &
KINEMATICS_cleavage_opening_label, &
@ -84,8 +77,6 @@ subroutine kinematics_cleavage_opening_init()
integer(pInt) :: maxNinstance,p,instance,kinematics
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt)
if (maxNinstance == 0_pInt) return
@ -145,7 +136,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i
math_mul33xx33
use material, only: &
material_phase, &
material_homog, &
material_homogenizationAt, &
damage, &
damageMapping
use lattice, only: &
@ -174,7 +165,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i
phase = material_phase(ipc,ip,el)
instance = kinematics_cleavage_opening_instance(phase)
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
Ld = 0.0_pReal

168
src/kinematics_slipplane_opening.f90
View File

@ -22,26 +22,14 @@ module kinematics_slipplane_opening
sdot0, &
n
real(pReal), dimension(:), allocatable :: &
critDisp, &
critPlasticStrain
end type
critLoad
real(pReal), dimension(:,:), allocatable :: &
slip_direction, &
slip_normal, &
slip_transverse
end type tParameters
! Begin Deprecated
integer(pInt), dimension(:), allocatable, private :: &
kinematics_slipplane_opening_totalNslip !< total number of slip systems
integer(pInt), dimension(:,:), allocatable, private :: &
kinematics_slipplane_opening_Nslip !< number of slip systems per family
real(pReal), dimension(:), allocatable, private :: &
kinematics_slipplane_opening_sdot_0, &
kinematics_slipplane_opening_N
real(pReal), dimension(:,:), allocatable, private :: &
kinematics_slipplane_opening_critPlasticStrain, &
kinematics_slipplane_opening_critLoad
! End Deprecated
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
public :: &
kinematics_slipplane_opening_init, &
kinematics_slipplane_opening_LiAndItsTangent
@ -54,11 +42,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_slipplane_opening_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use debug, only: &
debug_level,&
debug_constitutive,&
@ -66,29 +49,23 @@ subroutine kinematics_slipplane_opening_init()
use config, only: &
config_phase
use IO, only: &
IO_warning, &
IO_error, &
IO_timeStamp
IO_error
use math, only: &
math_expand
use material, only: &
phase_kinematics, &
KINEMATICS_slipplane_opening_label, &
KINEMATICS_slipplane_opening_ID
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem
use lattice
implicit none
integer(pInt), allocatable, dimension(:) :: tempInt
real(pReal), allocatable, dimension(:) :: tempFloat
integer(pInt) :: maxNinstance,p,instance,kinematics
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt)
if (maxNinstance == 0_pInt) return
maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID)
if (maxNinstance == 0) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
@ -97,38 +74,38 @@ subroutine kinematics_slipplane_opening_init()
do p = 1_pInt, size(config_phase)
kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct?
enddo
allocate(kinematics_slipplane_opening_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_slipplane_opening_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal)
allocate(kinematics_slipplane_opening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_totalNslip(maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_N(maxNinstance), source=0.0_pReal)
allocate(kinematics_slipplane_opening_sdot_0(maxNinstance), source=0.0_pReal)
allocate(param(maxNinstance))
do p = 1_pInt, size(config_phase)
if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle
associate(prm => param(kinematics_slipplane_opening_instance(p)), &
config => config_phase(p))
instance = kinematics_slipplane_opening_instance(p)
kinematics_slipplane_opening_sdot_0(instance) = config_phase(p)%getFloat('anisoductile_sdot0')
kinematics_slipplane_opening_N(instance) = config_phase(p)%getFloat('anisoductile_ratesensitivity')
tempInt = config_phase(p)%getInts('ncleavage')
kinematics_slipplane_opening_Nslip(1:size(tempInt),instance) = tempInt
prm%sdot0 = config_phase(p)%getFloat('anisoductile_sdot0')
prm%n = config_phase(p)%getFloat('anisoductile_ratesensitivity')
prm%Nslip = config%getInts('nslip')
tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(tempInt))
kinematics_slipplane_opening_critPlasticStrain(1:size(tempInt),instance) = tempFloat
prm%critLoad = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(prm%Nslip ))
tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(tempInt))
kinematics_slipplane_opening_critLoad(1:size(tempInt),instance) = tempFloat
prm%critLoad = math_expand(prm%critLoad, prm%Nslip)
prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),&
config%getFloat('c/a',defaultVal=0.0_pReal))
prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),&
config%getFloat('c/a',defaultVal=0.0_pReal))
prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),&
config%getFloat('c/a',defaultVal=0.0_pReal))
kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = &
min(lattice_NslipSystem(1:lattice_maxNslipFamily,p),& ! limit active cleavage systems per family to min of available and requested
kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance))
kinematics_slipplane_opening_totalNslip(instance) = sum(kinematics_slipplane_opening_Nslip(:,instance))
if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')')
if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')')
if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')')
! if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) &
! call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')')
! if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) &
! call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')')
! if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) &
! call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')')
end associate
enddo
end subroutine kinematics_slipplane_opening_init
@ -140,23 +117,16 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
use prec, only: &
tol_math_check
use math, only: &
math_mul33xx33
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_sd, &
lattice_st, &
lattice_sn
math_mul33xx33, &
math_outer
use material, only: &
material_phase, &
material_homog, &
material_homogenizationAt, &
damage, &
damageMapping
use math, only: &
math_tensorproduct33
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
@ -168,79 +138,73 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor)
real(pReal), dimension(3,3) :: &
projection_d, projection_t, projection_n !< projection modes 3x3 tensor
integer(pInt) :: &
integer :: &
instance, phase, &
homog, damageOffset, &
f, i, index_myFamily, k, l, m, n
i, k, l, m, n
real(pReal) :: &
traction_d, traction_t, traction_n, traction_crit, &
udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
phase = material_phase(ipc,ip,el)
instance = kinematics_slipplane_opening_instance(phase)
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
associate(prm => param(instance))
Ld = 0.0_pReal
dLd_dTstar = 0.0_pReal
do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family
do i = 1_pInt,kinematics_slipplane_opening_Nslip(f,instance) ! process each (active) slip system in family
projection_d = math_tensorproduct33(lattice_sd(1:3,index_myFamily+i,phase),&
lattice_sn(1:3,index_myFamily+i,phase))
projection_t = math_tensorproduct33(lattice_st(1:3,index_myFamily+i,phase),&
lattice_sn(1:3,index_myFamily+i,phase))
projection_n = math_tensorproduct33(lattice_sn(1:3,index_myFamily+i,phase),&
lattice_sn(1:3,index_myFamily+i,phase))
do i = 1, prm%totalNslip
projection_d = math_outer(prm%slip_direction(1:3,i),prm%slip_normal(1:3,i))
projection_t = math_outer(prm%slip_transverse(1:3,i),prm%slip_normal(1:3,i))
projection_n = math_outer(prm%slip_normal(1:3,i),prm%slip_normal(1:3,i))
traction_d = math_mul33xx33(S,projection_d)
traction_t = math_mul33xx33(S,projection_t)
traction_n = math_mul33xx33(S,projection_n)
traction_crit = kinematics_slipplane_opening_critLoad(f,instance)* &
damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage
traction_crit = prm%critLoad(i)* damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage
udotd = &
sign(1.0_pReal,traction_d)* &
kinematics_slipplane_opening_sdot_0(instance)* &
udotd = sign(1.0_pReal,traction_d)* &
prm%sdot0* &
(abs(traction_d)/traction_crit - &
abs(traction_d)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance)
abs(traction_d)/prm%critLoad(i))**prm%n
if (abs(udotd) > tol_math_check) then
Ld = Ld + udotd*projection_d
dudotd_dt = udotd*kinematics_slipplane_opening_N(instance)/traction_d
dudotd_dt = udotd*prm%n/traction_d
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotd_dt*projection_d(k,l)*projection_d(m,n)
endif
udott = &
sign(1.0_pReal,traction_t)* &
kinematics_slipplane_opening_sdot_0(instance)* &
udott = sign(1.0_pReal,traction_t)* &
prm%sdot0* &
(abs(traction_t)/traction_crit - &
abs(traction_t)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance)
abs(traction_t)/prm%critLoad(i))**prm%n
if (abs(udott) > tol_math_check) then
Ld = Ld + udott*projection_t
dudott_dt = udott*kinematics_slipplane_opening_N(instance)/traction_t
dudott_dt = udott*prm%n/traction_t
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudott_dt*projection_t(k,l)*projection_t(m,n)
endif
udotn = &
kinematics_slipplane_opening_sdot_0(instance)* &
prm%sdot0* &
(max(0.0_pReal,traction_n)/traction_crit - &
max(0.0_pReal,traction_n)/kinematics_slipplane_opening_critLoad(f,instance))**kinematics_slipplane_opening_N(instance)
max(0.0_pReal,traction_n)/prm%critLoad(i))**prm%n
if (abs(udotn) > tol_math_check) then
Ld = Ld + udotn*projection_n
dudotn_dt = udotn*kinematics_slipplane_opening_N(instance)/traction_n
dudotn_dt = udotn*prm%n/traction_n
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotn_dt*projection_n(k,l)*projection_n(m,n)
endif
enddo
enddo
end associate
end subroutine kinematics_slipplane_opening_LiAndItsTangent
end module kinematics_slipplane_opening

4
src/kinematics_thermal_expansion.f90
View File

@ -112,7 +112,7 @@ end function kinematics_thermal_expansion_initialStrain
subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el)
use material, only: &
material_phase, &
material_homog, &
material_homogenizationAt, &
temperature, &
temperatureRate, &
thermalMapping
@ -136,7 +136,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip,
T, TRef, TDot
phase = material_phase(ipc,ip,el)
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
offset = thermalMapping(homog)%p(ip,el)
T = temperature(homog)%p(offset)
TDot = temperatureRate(homog)%p(offset)

280
src/lattice.f90
View File

@ -16,27 +16,20 @@ module lattice
! BEGIN DEPRECATED
integer(pInt), parameter, public :: &
LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures
LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures
integer(pInt), allocatable, dimension(:,:), protected, public :: &
lattice_NslipSystem, & !< total # of slip systems in each family
lattice_NcleavageSystem !< total # of transformation systems in each family
real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: &
lattice_Scleavage !< Schmid matrices for cleavage systems
real(pReal), allocatable, dimension(:,:,:), protected, public :: &
lattice_sn, & !< normal direction of slip system
lattice_st, & !< sd x sn
lattice_sd !< slip direction of slip system
! END DEPRECATED
!--------------------------------------------------------------------------------------------------
! face centered cubic
integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: &
LATTICE_FCC_NSLIPSYSTEM = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc
integer(pInt), dimension(2), parameter, private :: &
LATTICE_FCC_NSLIPSYSTEM = int([12, 6],pInt) !< # of slip systems per family for fcc
integer(pInt), dimension(1), parameter, private :: &
LATTICE_FCC_NTWINSYSTEM = int([12],pInt) !< # of twin systems per family for fcc
@ -44,8 +37,8 @@ module lattice
integer(pInt), dimension(1), parameter, private :: &
LATTICE_FCC_NTRANSSYSTEM = int([12],pInt) !< # of transformation systems per family for fcc
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: &
LATTICE_FCC_NCLEAVAGESYSTEM = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc
integer(pInt), dimension(2), parameter, private :: &
LATTICE_FCC_NCLEAVAGESYSTEM = int([3, 4 ],pInt) !< # of cleavage systems per family for fcc
integer(pInt), parameter, private :: &
LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc
@ -118,7 +111,7 @@ module lattice
],pInt),shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR))
real(pReal), dimension(3+3,LATTICE_fcc_Ncleavage), parameter, private :: &
LATTICE_fcc_systemCleavage = reshape(real([&
LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([&
! Cleavage direction Plane normal
0, 1, 0, 1, 0, 0, &
0, 0, 1, 0, 1, 0, &
@ -131,22 +124,22 @@ module lattice
!--------------------------------------------------------------------------------------------------
! body centered cubic
integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: &
LATTICE_BCC_NSLIPSYSTEM = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc
integer(pInt), dimension(2), parameter, private :: &
LATTICE_BCC_NSLIPSYSTEM = int([12, 12], pInt) !< # of slip systems per family for bcc
integer(pInt), dimension(1), parameter, private :: &
LATTICE_BCC_NTWINSYSTEM = int([12], pInt) !< # of twin systems per family for bcc
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: &
LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc
integer(pInt), dimension(2), parameter, private :: &
LATTICE_BCC_NCLEAVAGESYSTEM = int([3, 6],pInt) !< # of cleavage systems per family for bcc
integer(pInt), parameter, private :: &
LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc
LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc
LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc
LATTICE_BCC_NCLEAVAGE = sum(LATTICE_BCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for bcc
real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: &
LATTICE_bcc_systemSlip = reshape(real([&
LATTICE_BCC_SYSTEMSLIP = reshape(real([&
! Slip direction Plane normal
! Slip system <111>{110}
1,-1, 1, 0, 1, 1, &
@ -181,7 +174,7 @@ module lattice
'<1 -1 1>{2 1 1}']
real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: &
LATTICE_bcc_systemTwin = reshape(real([&
LATTICE_BCC_SYSTEMTWIN = reshape(real([&
! Twin system <111>{112}
-1, 1, 1, 2, 1, 1, &
1, 1, 1, -2, 1, 1, &
@ -201,7 +194,7 @@ module lattice
['<1 1 1>{2 1 1}']
real(pReal), dimension(3+3,LATTICE_bcc_Ncleavage), parameter, private :: &
LATTICE_bcc_systemCleavage = reshape(real([&
LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([&
! Cleavage direction Plane normal
0, 1, 0, 1, 0, 0, &
0, 0, 1, 0, 1, 0, &
@ -216,22 +209,22 @@ module lattice
!--------------------------------------------------------------------------------------------------
! hexagonal
integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: &
LATTICE_HEX_NSLIPSYSTEM = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex
integer(pInt), dimension(6), parameter, private :: &
LATTICE_HEX_NSLIPSYSTEM = int([ 3, 3, 3, 6, 12, 6],pInt) !< # of slip systems per family for hex
integer(pInt), dimension(4), parameter, private :: &
LATTICE_HEX_NTWINSYSTEM = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: &
LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex
integer(pInt), dimension(1), parameter, private :: &
LATTICE_HEX_NCLEAVAGESYSTEM = int([3],pInt) !< # of cleavage systems per family for hex
integer(pInt), parameter, private :: &
LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSystem), & !< total # of slip systems for hex
LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex
LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex
LATTICE_HEX_NCLEAVAGE = sum(LATTICE_HEX_NCLEAVAGESYSTEM) !< total # of cleavage systems for hex
real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: &
LATTICE_hex_systemSlip = reshape(real([&
LATTICE_HEX_SYSTEMSLIP = reshape(real([&
! Slip direction Plane normal
! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base))
2, -1, -1, 0, 0, 0, 0, 1, &
@ -282,8 +275,8 @@ module lattice
'<1 1 . 3>{-1 0 . 1} ', &
'<1 1 . 3>{-1 -1 . 2}']
real(pReal), dimension(4+4,LATTICE_hex_Ntwin), parameter, private :: &
LATTICE_hex_systemTwin = reshape(real([&
real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: &
LATTICE_HEX_SYSTEMTWIN = reshape(real([&
! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981)
1, -1, 0, 1, -1, 1, 0, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a)
-1, 0, 1, 1, 1, 0, -1, 2, &
@ -320,8 +313,8 @@ module lattice
'<1 0 . -2>{1 0 . 1} ', &
'<1 1 . -3>{1 1 . 2} ']
real(pReal), dimension(4+4,LATTICE_hex_Ncleavage), parameter, private :: &
LATTICE_hex_systemCleavage = reshape(real([&
real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: &
LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([&
! Cleavage direction Plane normal
2,-1,-1, 0, 0, 0, 0, 1, &
0, 0, 0, 1, 2,-1,-1, 0, &
@ -331,14 +324,14 @@ module lattice
!--------------------------------------------------------------------------------------------------
! body centered tetragonal
integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: &
LATTICE_bct_NslipSystem = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009
integer(pInt), dimension(13), parameter, private :: &
LATTICE_BCT_NSLIPSYSTEM = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009
integer(pInt), parameter, private :: &
LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem) !< total # of slip systems for bct
LATTICE_BCT_NSLIP = sum(LATTICE_BCT_NSLIPSYSTEM) !< total # of slip systems for bct
real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: &
LATTICE_bct_systemSlip = reshape(real([&
real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter, private :: &
LATTICE_BCT_SYSTEMSLIP = reshape(real([&
! Slip direction Plane normal
! Slip family 1 {100)<001] (Bravais notation {hkl)<uvw] for bct c/a = 0.5456)
0, 0, 1, 1, 0, 0, &
@ -405,7 +398,7 @@ module lattice
1,-1, 1, -2,-1, 1, &
-1, 1, 1, -1,-2, 1, &
1, 1, 1, 1,-2, 1 &
],pReal),[ 3_pInt + 3_pInt,LATTICE_bct_Nslip]) !< slip systems for bct sorted by Bieler
],pReal),[ 3_pInt + 3_pInt,LATTICE_BCT_NSLIP]) !< slip systems for bct sorted by Bieler
character(len=*), dimension(13), parameter, private :: LATTICE_BCT_SLIPFAMILY_NAME = &
['{1 0 0)<0 0 1] ', &
@ -425,8 +418,8 @@ module lattice
!--------------------------------------------------------------------------------------------------
! isotropic
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: &
LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso
integer(pInt), dimension(1), parameter, private :: &
LATTICE_iso_NcleavageSystem = int([3],pInt) !< # of cleavage systems per family for iso
integer(pInt), parameter, private :: &
LATTICE_iso_Ncleavage = sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso
@ -442,7 +435,7 @@ module lattice
!--------------------------------------------------------------------------------------------------
! orthorhombic
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: &
integer(pInt), dimension(3), parameter, private :: &
LATTICE_ort_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho
integer(pInt), parameter, private :: &
@ -458,8 +451,6 @@ module lattice
! BEGIN DEPRECATED
integer(pInt), parameter, public :: &
LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_HEX_NSLIP, &
LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures
LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, &
LATTICE_hex_Ncleavage, &
LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage) !< max # of cleavage systems over lattice structures
@ -511,19 +502,6 @@ module lattice
module procedure slipProjection_direction
end interface lattice_forestProjection_screw
interface lattice_slipProjection_modeI
module procedure slipProjection_normal
end interface lattice_slipProjection_modeI
interface lattice_slipProjection_modeII
module procedure slipProjection_direction
end interface lattice_slipProjection_modeII
interface lattice_slipProjection_modeIII
module procedure slipProjection_transverse
end interface lattice_slipProjection_modeIII
public :: &
lattice_init, &
lattice_qDisorientation, &
@ -548,9 +526,6 @@ module lattice
lattice_forestProjection, &
lattice_forestProjection_edge, &
lattice_forestProjection_screw, &
lattice_slipProjection_modeI, &
lattice_slipProjection_modeII, &
lattice_slipProjection_modeIII, &
lattice_slip_normal, &
lattice_slip_direction, &
lattice_slip_transverse
@ -597,18 +572,12 @@ subroutine lattice_init
allocate(lattice_mu(Nphases), source=0.0_pReal)
allocate(lattice_nu(Nphases), source=0.0_pReal)
allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt)
allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal)
allocate(lattice_Scleavage(3,3,3,lattice_maxNcleavage,Nphases),source=0.0_pReal)
allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt)
allocate(CoverA(Nphases),source=0.0_pReal)
allocate(lattice_sd(3,lattice_maxNslip,Nphases),source=0.0_pReal)
allocate(lattice_st(3,lattice_maxNslip,Nphases),source=0.0_pReal)
allocate(lattice_sn(3,lattice_maxNslip,Nphases),source=0.0_pReal)
do p = 1, size(config_phase)
tag = config_phase(p)%getString('lattice_structure')
select case(trim(tag))
@ -689,7 +658,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
math_mul33x33, &
math_sym3333to66, &
math_Voigt66to3333, &
math_crossproduct
math_cross
use IO, only: &
IO_error
@ -698,11 +667,9 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
real(pReal), intent(in) :: &
CoverA
real(pReal), dimension(3,lattice_maxNslip) :: &
sd, sn
integer(pInt) :: &
i, &
myNslip, myNcleavage
myNcleavage
lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),&
lattice_C66(1:6,1:6,myPhase))
@ -731,91 +698,43 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
lattice_thermalConductivity33 (1:3,1:3,myPhase))
lattice_DamageDiffusion33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),&
lattice_DamageDiffusion33 (1:3,1:3,myPhase))
myNslip = 0_pInt
myNcleavage = 0_pInt
select case(lattice_structure(myPhase))
!--------------------------------------------------------------------------------------------------
! fcc
case (LATTICE_fcc_ID)
myNslip = LATTICE_FCC_NSLIP
myNcleavage = lattice_fcc_Ncleavage
lattice_NslipSystem (1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem
lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem
lattice_NcleavageSystem(1:2,myPhase) = lattice_fcc_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavageSystem,'fcc',covera)
do i = 1_pInt,myNslip
sd(1:3,i) = lattice_fcc_systemSlip(1:3,i)
sn(1:3,i) = lattice_fcc_systemSlip(4:6,i)
enddo
!--------------------------------------------------------------------------------------------------
! bcc
case (LATTICE_bcc_ID)
myNslip = LATTICE_BCC_NSLIP
myNcleavage = lattice_bcc_Ncleavage
lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem
lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem
lattice_NcleavageSystem(1:2,myPhase) = lattice_bcc_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera)
do i = 1_pInt,myNslip
sd(1:3,i) = lattice_bcc_systemSlip(1:3,i)
sn(1:3,i) = lattice_bcc_systemSlip(4:6,i)
enddo
!--------------------------------------------------------------------------------------------------
! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices)
case (LATTICE_hex_ID)
myNslip = LATTICE_HEX_NSLIP
myNcleavage = lattice_hex_Ncleavage
lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = LATTICE_HEX_NSLIPSystem
lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem
lattice_NcleavageSystem(1:1,myPhase) = lattice_hex_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_hex_ncleavagesystem,'hex',covera)
do i = 1_pInt,myNslip ! assign slip system vectors
sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]
sd(2,i) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*&
0.5_pReal*sqrt(3.0_pReal)
sd(3,i) = lattice_hex_systemSlip(4,i)*CoverA
sn(1,i) = lattice_hex_systemSlip(5,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a))
sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal)
sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA
enddo
!--------------------------------------------------------------------------------------------------
! bct
case (LATTICE_bct_ID)
myNslip = lattice_bct_Nslip
lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem
do i = 1_pInt,myNslip ! assign slip system vectors
sd(1:2,i) = lattice_bct_systemSlip(1:2,i)
sd(3,i) = lattice_bct_systemSlip(3,i)*CoverA
sn(1:2,i) = lattice_bct_systemSlip(4:5,i)
sn(3,i) = lattice_bct_systemSlip(6,i)/CoverA
enddo
!--------------------------------------------------------------------------------------------------
! orthorhombic (no crystal plasticity)
case (LATTICE_ort_ID)
myNcleavage = lattice_ort_Ncleavage
lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_ort_NcleavageSystem
lattice_NcleavageSystem(1:3,myPhase) = lattice_ort_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_ort_NcleavageSystem,'ort',covera)
!--------------------------------------------------------------------------------------------------
! isotropic (no crystal plasticity)
case (LATTICE_iso_ID)
myNcleavage = lattice_iso_Ncleavage
lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_iso_NcleavageSystem
lattice_NcleavageSystem(1:1,myPhase) = lattice_iso_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_iso_NcleavageSystem,'iso',covera)
@ -826,13 +745,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
call IO_error(130_pInt,ext_msg='lattice_initializeStructure')
end select
do i = 1_pInt,myNslip ! store slip system vectors and Schmid matrix for my structure
lattice_sd(1:3,i,myPhase) = sd(1:3,i)/norm2(sd(1:3,i)) ! make unit vector
lattice_sn(1:3,i,myPhase) = sn(1:3,i)/norm2(sn(1:3,i)) ! make unit vector
lattice_st(1:3,i,myPhase) = math_crossproduct(lattice_sd(1:3,i,myPhase),lattice_sn(1:3,i,myPhase))
enddo
end subroutine lattice_initializeStructure
@ -1172,7 +1084,7 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA)
use IO, only: &
IO_error
use math, only: &
INRAD, &
PI, &
math_axisAngleToR, &
math_sym3333to66, &
math_66toSym3333, &
@ -1208,7 +1120,7 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA)
end select
do i = 1, sum(Ntwin)
R = math_axisAngleToR(coordinateSystem(1:3,2,i), 180.0_pReal * INRAD) ! ToDo: Why always 180 deg?
R = math_axisAngleToR(coordinateSystem(1:3,2,i), PI) ! ToDo: Why always 180 deg?
lattice_C66_twin(1:6,1:6,i) = math_sym3333to66(math_rotate_forward3333(math_66toSym3333(C66),R))
enddo
end function lattice_C66_twin
@ -1231,9 +1143,7 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, &
math_sym3333to66, &
math_66toSym3333, &
math_rotate_forward3333, &
math_mul33x33, &
math_tensorproduct33, &
math_crossproduct
math_mul33x33
implicit none
integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family
@ -1299,8 +1209,8 @@ function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSc
IO_error
use math, only: &
INRAD, &
math_tensorproduct33, &
math_crossproduct, &
math_outer, &
math_cross, &
math_mul33x3, &
math_axisAngleToR
implicit none
@ -1326,18 +1236,18 @@ function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSc
normal = coordinateSystem(1:3,2,i)
np = math_mul33x3(math_axisAngleToR(direction,60.0_pReal*INRAD), normal)
if (size(nonSchmidCoefficients)>0) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(1) * math_tensorproduct33(direction, np)
+ nonSchmidCoefficients(1) * math_outer(direction, np)
if (size(nonSchmidCoefficients)>1) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(2) * math_tensorproduct33(math_crossproduct(normal, direction), normal)
+ nonSchmidCoefficients(2) * math_outer(math_cross(normal, direction), normal)
if (size(nonSchmidCoefficients)>2) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(3) * math_tensorproduct33(math_crossproduct(np, direction), np)
+ nonSchmidCoefficients(3) * math_outer(math_cross(np, direction), np)
if (size(nonSchmidCoefficients)>3) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(4) * math_tensorproduct33(normal, normal)
+ nonSchmidCoefficients(4) * math_outer(normal, normal)
if (size(nonSchmidCoefficients)>4) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(5) * math_tensorproduct33(math_crossproduct(normal, direction), &
math_crossproduct(normal, direction))
+ nonSchmidCoefficients(5) * math_outer(math_cross(normal, direction), &
math_cross(normal, direction))
if (size(nonSchmidCoefficients)>5) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(6) * math_tensorproduct33(direction, direction)
+ nonSchmidCoefficients(6) * math_outer(direction, direction)
enddo
end function lattice_nonSchmidMatrix
@ -2012,7 +1922,7 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix)
IO_error
use math, only: &
math_trace33, &
math_tensorproduct33
math_outer
implicit none
integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family
@ -2053,7 +1963,7 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix)
coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA)
do i = 1, sum(Nslip)
SchmidMatrix(1:3,1:3,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
call IO_error(0_pInt,i,ext_msg = 'dilatational Schmid matrix for slip')
enddo
@ -2072,7 +1982,7 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
IO_error
use math, only: &
math_trace33, &
math_tensorproduct33
math_outer
implicit none
integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
@ -2110,7 +2020,7 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
coordinateSystem = buildCoordinateSystem(Ntwin,NtwinMax,twinSystems,structure,cOverA)
do i = 1, sum(Ntwin)
SchmidMatrix(1:3,1:3,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
call IO_error(0_pInt,i,ext_msg = 'dilatational Schmid matrix for twin')
enddo
@ -2123,13 +2033,8 @@ end function lattice_SchmidMatrix_twin
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix)
use prec, only: &
tol_math_check
use IO, only: &
IO_error
use math, only: &
math_trace33, &
math_tensorproduct33
implicit none
integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family
@ -2160,7 +2065,7 @@ function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc)
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix)
use math, only: &
math_tensorproduct33
math_outer
use IO, only: &
IO_error
@ -2206,9 +2111,9 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid
coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA)
do i = 1, sum(Ncleavage)
SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i))
SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i))
SchmidMatrix(1:3,1:3,1,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
SchmidMatrix(1:3,1:3,2,i) = math_outer(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i))
SchmidMatrix(1:3,1:3,3,i) = math_outer(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i))
enddo
end function lattice_SchmidMatrix_cleavage
@ -2274,12 +2179,11 @@ end function lattice_slip_transverse
!--------------------------------------------------------------------------------------------------
!> @brief Projection of the transverse direction onto the slip plane
!> @details: This projection is used to calculate forest hardening for edge dislocations and for
! mode III failure (ToDo: MD I am not 100% sure about mode III)
!> @details: This projection is used to calculate forest hardening for edge dislocations
!--------------------------------------------------------------------------------------------------
function slipProjection_transverse(Nslip,structure,cOverA) result(projection)
use math, only: &
math_mul3x3
math_inner
implicit none
integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family
@ -2293,7 +2197,7 @@ function slipProjection_transverse(Nslip,structure,cOverA) result(projection)
coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA)
do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip)
projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j)))
projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j)))
enddo; enddo
end function slipProjection_transverse
@ -2301,12 +2205,11 @@ end function slipProjection_transverse
!--------------------------------------------------------------------------------------------------
!> @brief Projection of the slip direction onto the slip plane
!> @details: This projection is used to calculate forest hardening for screw dislocations and for
! mode II failure (ToDo: MD I am not 100% sure about mode II)
!> @details: This projection is used to calculate forest hardening for screw dislocations
!--------------------------------------------------------------------------------------------------
function slipProjection_direction(Nslip,structure,cOverA) result(projection)
use math, only: &
math_mul3x3
math_inner
implicit none
integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family
@ -2320,45 +2223,17 @@ function slipProjection_direction(Nslip,structure,cOverA) result(projection)
coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA)
do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip)
projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j)))
projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j)))
enddo; enddo
end function slipProjection_direction
!--------------------------------------------------------------------------------------------------
!> @brief Projection of the slip plane onto itself
!> @details: This projection is used for mode I failure
!--------------------------------------------------------------------------------------------------
function slipProjection_normal(Nslip,structure,cOverA) result(projection)
use math, only: &
math_mul3x3
implicit none
integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: structure !< lattice structure
real(pReal), intent(in) :: cOverA !< c/a ratio
real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection
real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
integer(pInt) :: i, j
coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA)
do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip)
projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,j)))
enddo; enddo
end function slipProjection_normal
!--------------------------------------------------------------------------------------------------
!> @brief build a local coordinate system on slip systems
!> @details Order: Direction, plane (normal), and common perpendicular
!--------------------------------------------------------------------------------------------------
function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem)
use math, only: &
math_mul3x3
use IO, only: &
IO_error
@ -2406,6 +2281,7 @@ end function coordinateSystem_slip
function buildInteraction(activeA,activeB,maxA,maxB,values,matrix)
use IO, only: &
IO_error
implicit none
integer(pInt), dimension(:), intent(in) :: &
activeA, & !< number of active systems as specified in material.config
@ -2446,7 +2322,7 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA)
use IO, only: &
IO_error
use math, only: &
math_crossproduct
math_cross
implicit none
integer(pInt), dimension(:), intent(in) :: &
@ -2503,8 +2379,8 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA)
buildCoordinateSystem(1:3,1,a) = direction/norm2(direction)
buildCoordinateSystem(1:3,2,a) = normal/norm2(normal)
buildCoordinateSystem(1:3,3,a) = math_crossproduct(buildCoordinateSystem(1:3,1,a),&
buildCoordinateSystem(1:3,2,a))
buildCoordinateSystem(1:3,3,a) = math_cross(buildCoordinateSystem(1:3,1,a),&
buildCoordinateSystem(1:3,2,a))
enddo activeSystems
enddo activeFamilies
@ -2522,8 +2398,8 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc)
use prec, only: &
dEq0
use math, only: &
math_crossproduct, &
math_tensorproduct33, &
math_cross, &
math_outer, &
math_mul33x33, &
math_mul33x3, &
math_axisAngleToR, &
@ -2627,9 +2503,9 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc)
y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal)
z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal)
U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) &
+ (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) &
+ (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal)
U = (a_bcc/a_fcc)*math_outer(x,x) &
+ (a_bcc/a_fcc)*math_outer(y,y) * sqrt(2.0_pReal) &
+ (a_bcc/a_fcc)*math_outer(z,z) * sqrt(2.0_pReal)
Q(1:3,1:3,i) = math_mul33x33(R,B)
S(1:3,1:3,i) = math_mul33x33(R,U) - MATH_I3
enddo
@ -2643,7 +2519,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc)
do i = 1_pInt,sum(Ntrans)
x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i))
z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i))
y = -math_crossproduct(x,z)
y = -math_cross(x,z)
Q(1:3,1,i) = x
Q(1:3,2,i) = y
Q(1:3,3,i) = z

58
src/material.f90
View File

@ -162,10 +162,6 @@ module material
! DEPRECATED: use material_phaseAt
integer(pInt), dimension(:,:,:), allocatable, public :: &
material_phase !< phase (index) of each grain,IP,element
! DEPRECATED: use material_homogenizationAt
integer(pInt), dimension(:,:), allocatable, public :: &
material_homog !< homogenization (index) of each IP,element
! END DEPRECATED
type(tPlasticState), allocatable, dimension(:), public :: &
plasticState
@ -280,14 +276,8 @@ contains
!> material.config
!--------------------------------------------------------------------------------------------------
subroutine material_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_error, &
IO_timeStamp
IO_error
use debug, only: &
debug_level, &
debug_material, &
@ -304,7 +294,6 @@ subroutine material_init()
phase_name, &
texture_name
use mesh, only: &
mesh_homogenizationAt, &
theMesh
implicit none
@ -321,8 +310,6 @@ subroutine material_init()
myDebug = debug_level(debug_material)
write(6,'(/,a)') ' <<<+- material init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
call material_parsePhase()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
@ -403,16 +390,18 @@ subroutine material_init()
allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt)
! END DEPRECATED
allocate(material_homogenizationAt,source=mesh_homogenizationAt)
allocate(material_homogenizationAt,source=theMesh%homogenizationAt)
allocate(material_AggregateAt, source=theMesh%homogenizationAt)
allocate(CounterPhase (size(config_phase)), source=0_pInt)
allocate(CounterHomogenization(size(config_homogenization)),source=0_pInt)
! BEGIN DEPRECATED
do e = 1_pInt,theMesh%Nelems
myHomog = mesh_homogenizationAt(e)
myHomog = theMesh%homogenizationAt(e)
do i = 1_pInt, theMesh%elem%nIPs
CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt
mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),myHomog]
mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)]
do g = 1_pInt,homogenization_Ngrains(myHomog)
myPhase = material_phase(g,i,e)
CounterPhase(myPhase) = CounterPhase(myPhase)+1_pInt ! not distinguishing between instances of same phase
@ -443,7 +432,7 @@ subroutine material_parseHomogenization
use config, only : &
config_homogenization
use mesh, only: &
mesh_homogenizationAt
theMesh
use IO, only: &
IO_error
@ -464,7 +453,7 @@ subroutine material_parseHomogenization
allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal)
forall (h = 1_pInt:size(config_homogenization)) &
homogenization_active(h) = any(mesh_homogenizationAt == h)
homogenization_active(h) = any(theMesh%homogenizationAt == h)
do h=1_pInt, size(config_homogenization)
@ -550,7 +539,6 @@ subroutine material_parseMicrostructure
config_microstructure, &
microstructure_name
use mesh, only: &
mesh_microstructureAt, &
theMesh
implicit none
@ -566,11 +554,11 @@ subroutine material_parseMicrostructure
allocate(microstructure_active(size(config_microstructure)), source=.false.)
allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.)
if(any(mesh_microstructureAt > size(config_microstructure))) &
if(any(theMesh%microstructureAt > size(config_microstructure))) &
call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config')
forall (e = 1_pInt:theMesh%Nelems) &
microstructure_active(mesh_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
microstructure_active(theMesh%microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
do m=1_pInt, size(config_microstructure)
microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)')
@ -695,7 +683,7 @@ subroutine material_parsePhase
allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), &
source=STIFFNESS_DEGRADATION_undefined_ID)
do p=1_pInt, size(config_phase)
#if defined(__GFORTRAN__)
#if defined(__GFORTRAN__) || defined(__PGI)
str = ['GfortranBug86277']
str = config_phase(p)%getStrings('(source)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
@ -719,7 +707,7 @@ subroutine material_parsePhase
end select
enddo
#if defined(__GFORTRAN__)
#if defined(__GFORTRAN__) || defined(__PGI)
str = ['GfortranBug86277']
str = config_phase(p)%getStrings('(kinematics)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
@ -736,7 +724,7 @@ subroutine material_parsePhase
phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID
end select
enddo
#if defined(__GFORTRAN__)
#if defined(__GFORTRAN__) || defined(__PGI)
str = ['GfortranBug86277']
str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
@ -1021,8 +1009,6 @@ subroutine material_populateGrains
math_sampleFiberOri, &
math_symmetricEulers
use mesh, only: &
mesh_homogenizationAt, &
mesh_microstructureAt, &
theMesh, &
mesh_ipVolume
use config, only: &
@ -1055,31 +1041,25 @@ subroutine material_populateGrains
phaseID,textureID,dGrains,myNgrains,myNorientations,myNconstituents, &
grain,constituentGrain,ipGrain,symExtension, ip
real(pReal) :: deviation,extreme,rnd
integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array
type(group_int), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array
integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array
type(group_int), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array
myDebug = debug_level(debug_material)
allocate(material_volume(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0.0_pReal)
allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_homog(theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal)
allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt)
allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt)
! populating homogenization schemes in each
!--------------------------------------------------------------------------------------------------
do e = 1_pInt, theMesh%Nelems
material_homog(1_pInt:theMesh%elem%nIPs,e) = mesh_homogenizationAt(e)
enddo
!--------------------------------------------------------------------------------------------------
! precounting of elements for each homog/micro pair
do e = 1_pInt, theMesh%Nelems
homog = mesh_homogenizationAt(e)
micro = mesh_microstructureAt(e)
homog = theMesh%homogenizationAt(e)
micro = theMesh%microstructureAt(e)
Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt
enddo
allocate(elemsOfHomogMicro(size(config_homogenization),size(config_microstructure)))
@ -1096,8 +1076,8 @@ subroutine material_populateGrains
! identify maximum grain count per IP (from element) and find grains per homog/micro pair
Nelems = 0_pInt ! reuse as counter
elementLooping: do e = 1_pInt,theMesh%Nelems
homog = mesh_homogenizationAt(e)
micro = mesh_microstructureAt(e)
homog = theMesh%homogenizationAt(e)
micro = theMesh%microstructureAt(e)
if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds
call IO_error(154_pInt,e,0_pInt,0_pInt)
if (micro < 1_pInt .or. micro > size(config_microstructure)) & ! out of bounds

140
src/math.f90
View File

@ -68,49 +68,19 @@ module math
],[2,9]) !< arrangement in Plain notation
!--------------------------------------------------------------------------------------------------
! Provide deprecated names for compatibility
interface math_cross
module procedure math_crossproduct
end interface math_cross
! 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
! Provide deprecated name for compatibility
interface math_crossproduct
module procedure math_cross
end interface math_crossproduct
interface math_mul3x3
module procedure math_inner
end interface math_mul3x3
public :: &
math_Plain33to9, &
math_Plain9to33, &
math_Mandel33to6, &
math_Mandel6to33, &
math_Plain3333to99, &
math_Plain99to3333
math_mul3x3, &
math_crossproduct
!---------------------------------------------------------------------------------------------------
public :: &
#if defined(__PGI)
norm2, &
@ -124,16 +94,12 @@ module math
math_civita, &
math_delta, &
math_cross, &
math_crossproduct, &
math_tensorproduct33, &
math_mul3x3, &
math_mul6x6, &
math_outer, &
math_inner, &
math_mul33xx33, &
math_mul3333xx33, &
math_mul3333xx3333, &
math_mul33x33, &
math_mul66x66, &
math_mul99x99, &
math_mul33x3, &
math_mul33x3_complex, &
math_mul66x6 , &
@ -214,25 +180,16 @@ contains
!> @brief initialization of random seed generator
!--------------------------------------------------------------------------------------------------
subroutine math_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use numerics, only: randomSeed
use IO, only: IO_timeStamp
use numerics, only: &
randomSeed
implicit none
integer(pInt) :: i
real(pReal), dimension(4) :: randTest
! the following variables are system dependend and shound NOT be pInt
integer :: randSize ! gfortran requires a variable length to compile
integer, dimension(:), allocatable :: randInit ! if recalculations of former randomness (with given seed) is necessary
! comment the first random_seed call out, set randSize to 1, and use ifort
integer :: randSize
integer, dimension(:), allocatable :: randInit
write(6,'(/,a)') ' <<<+- math init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
call random_seed(size=randSize)
if (allocated(randInit)) deallocate(randInit)
@ -537,73 +494,46 @@ end function math_delta
!--------------------------------------------------------------------------------------------------
!> @brief cross product a x b
!--------------------------------------------------------------------------------------------------
pure function math_crossproduct(A,B)
pure function math_cross(A,B)
implicit none
real(pReal), dimension(3), intent(in) :: A,B
real(pReal), dimension(3) :: math_crossproduct
real(pReal), dimension(3) :: math_cross
math_crossproduct = [ A(2)*B(3) -A(3)*B(2), &
A(3)*B(1) -A(1)*B(3), &
A(1)*B(2) -A(2)*B(1) ]
math_cross = [ A(2)*B(3) -A(3)*B(2), &
A(3)*B(1) -A(1)*B(3), &
A(1)*B(2) -A(2)*B(1) ]
end function math_crossproduct
end function math_cross
!--------------------------------------------------------------------------------------------------
!> @brief tensor product A \otimes B of arbitrary sized vectors A and B
!> @brief outer product A \otimes B of arbitrary sized vectors A and B
!--------------------------------------------------------------------------------------------------
pure function math_tensorproduct(A,B)
pure function math_outer(A,B)
implicit none
real(pReal), dimension(:), intent(in) :: A,B
real(pReal), dimension(size(A,1),size(B,1)) :: math_tensorproduct
real(pReal), dimension(size(A,1),size(B,1)) :: math_outer
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_outer(i,j) = A(i)*B(j)
end function math_tensorproduct
end function math_outer
!--------------------------------------------------------------------------------------------------
!> @brief tensor product A \otimes B of leght-3 vectors A and B
!> @brief outer product A \otimes B of arbitrary sized vectors A and B
!--------------------------------------------------------------------------------------------------
pure function math_tensorproduct33(A,B)
real(pReal) pure function math_inner(A,B)
implicit none
real(pReal), dimension(3,3) :: math_tensorproduct33
real(pReal), dimension(3), intent(in) :: A,B
integer(pInt) :: i,j
real(pReal), dimension(:), intent(in) :: A
real(pReal), dimension(size(A,1)), intent(in) :: B
forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_tensorproduct33(i,j) = A(i)*B(j)
math_inner = sum(A*B)
end function math_tensorproduct33
!--------------------------------------------------------------------------------------------------
!> @brief matrix multiplication 3x3 = 1
!--------------------------------------------------------------------------------------------------
real(pReal) pure function math_mul3x3(A,B)
implicit none
real(pReal), dimension(3), intent(in) :: A,B
math_mul3x3 = sum(A*B)
end function math_mul3x3
!--------------------------------------------------------------------------------------------------
!> @brief matrix multiplication 6x6 = 1
!--------------------------------------------------------------------------------------------------
real(pReal) pure function math_mul6x6(A,B)
implicit none
real(pReal), dimension(6), intent(in) :: A,B
math_mul6x6 = sum(A*B)
end function math_mul6x6
end function math_inner
!--------------------------------------------------------------------------------------------------
@ -2108,7 +2038,7 @@ function math_eigenvectorBasisSym(m)
do i=1_pInt, size(m,1)
math_eigenvectorBasisSym = math_eigenvectorBasisSym &
+ sqrt(values(i)) * math_tensorproduct(vectors(:,i),vectors(:,i))
+ sqrt(values(i)) * math_outer(vectors(:,i),vectors(:,i))
enddo
end function math_eigenvectorBasisSym

15
src/mesh_FEM.f90
View File

@ -33,10 +33,6 @@ use PETScis
mesh_maxNips !< max number of IPs in any CP element
!!!! BEGIN DEPRECATED !!!!!
integer(pInt), dimension(:), allocatable, public, protected :: &
mesh_homogenizationAt, & !< homogenization ID of each element
mesh_microstructureAt !< microstructure ID of each element
integer(pInt), dimension(:,:), allocatable, public, protected :: &
mesh_element !DEPRECATED
@ -132,7 +128,6 @@ subroutine mesh_init()
IO_stringPos, &
IO_intValue, &
IO_EOF, &
IO_read, &
IO_isBlank
use debug, only: &
debug_e, &
@ -265,16 +260,12 @@ subroutine mesh_init()
allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP...
forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element
!!!! COMPATIBILITY HACK !!!!
! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes.
! hence, xxPerElem instead of maxXX
! better name
mesh_homogenizationAt = mesh_element(3,:)
mesh_microstructureAt = mesh_element(4,:)
!!!!!!!!!!!!!!!!!!!!!!!!
allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
call theMesh%init(dimplex,integrationOrder,mesh_node0)
call theMesh%setNelems(mesh_NcpElems)
theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:)
end subroutine mesh_init

13
src/mesh_abaqus.f90
View File

@ -25,10 +25,6 @@ module mesh
mesh_maxNcellnodes !< max number of cell nodes in any CP element
!!!! BEGIN DEPRECATED !!!!!
integer(pInt), dimension(:), allocatable, public, protected :: &
mesh_homogenizationAt, & !< homogenization ID of each element
mesh_microstructureAt !< microstructure ID of each element
integer(pInt), dimension(:,:), allocatable, public, protected :: &
mesh_element, & !DEPRECATED
mesh_sharedElem, & !< entryCount and list of elements containing node
@ -427,9 +423,7 @@ subroutine mesh_init(ip,el)
use DAMASK_interface
use IO, only: &
IO_open_InputFile, &
IO_timeStamp, &
IO_error, &
IO_write_jobFile
IO_error
use debug, only: &
debug_e, &
debug_i, &
@ -522,9 +516,8 @@ subroutine mesh_init(ip,el)
! better name
mesh_homogenizationAt = mesh_element(3,:)
mesh_microstructureAt = mesh_element(4,:)
theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:)
contains

17
src/mesh_grid.f90
View File

@ -22,9 +22,8 @@ module mesh
integer(pInt), dimension(:), allocatable, private :: &
microGlobal
integer(pInt), dimension(:), allocatable, public, protected :: &
mesh_homogenizationAt, & !< homogenization ID of each element
mesh_microstructureAt !< microstructure ID of each element
integer(pInt), dimension(:), allocatable, private :: &
mesh_homogenizationAt
integer(pInt), dimension(:,:), allocatable, public, protected :: &
mesh_element !< entryCount and list of elements containing node
@ -175,11 +174,7 @@ subroutine mesh_init(ip,el)
use DAMASK_interface
use IO, only: &
IO_open_file, &
IO_error, &
IO_timeStamp, &
IO_error, &
IO_write_jobFile
IO_error
use debug, only: &
debug_e, &
debug_i, &
@ -272,7 +267,8 @@ subroutine mesh_init(ip,el)
! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes.
! hence, xxPerElem instead of maxXX
! better name
mesh_microstructureAt = mesh_element(4,:)
theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:)
!!!!!!!!!!!!!!!!!!!!!!!!
deallocate(mesh_cell)
end subroutine mesh_init
@ -906,6 +902,9 @@ end function mesh_cellCenterCoordinates
!--------------------------------------------------------------------------------------------------
subroutine mesh_build_ipAreas
use math, only: &
#ifdef __PGI
norm2, &
#endif
math_crossproduct
implicit none

15
src/mesh_marc.f90
View File

@ -18,10 +18,6 @@ module mesh
mesh_Ncells, & !< total number of cells in mesh
mesh_maxNsharedElems !< max number of CP elements sharing a node
integer(pInt), dimension(:), allocatable, public, protected :: &
mesh_homogenizationAt, & !< homogenization ID of each element
mesh_microstructureAt !< microstructure ID of each element
integer(pInt), dimension(:,:), allocatable, public, protected :: &
mesh_element, & !DEPRECATED
mesh_sharedElem, & !< entryCount and list of elements containing node
@ -286,9 +282,7 @@ subroutine mesh_init(ip,el)
use DAMASK_interface
use IO, only: &
IO_open_InputFile, &
IO_timeStamp, &
IO_error, &
IO_write_jobFile
IO_error
use debug, only: &
debug_e, &
debug_i, &
@ -410,11 +404,8 @@ subroutine mesh_init(ip,el)
calcMode = .false. ! pretend to have collected what first call is asking (F = I)
calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc"
!!!! COMPATIBILITY HACK !!!!
! better name
mesh_homogenizationAt = mesh_element(3,:)
mesh_microstructureAt = mesh_element(4,:)
!!!!!!!!!!!!!!!!!!!!!!!!
theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:)
end subroutine mesh_init

39
src/numerics.f90
View File

@ -10,8 +10,6 @@ module numerics
implicit none
private
character(len=64), parameter, private :: &
numerics_CONFIGFILE = 'numerics.config' !< name of configuration file
integer(pInt), protected, public :: &
iJacoStiffness = 1_pInt, & !< frequency of stiffness update
@ -143,32 +141,32 @@ contains
! a sanity check
!--------------------------------------------------------------------------------------------------
subroutine numerics_init
use prec, only: &
pStringLen
use IO, only: &
IO_read, &
IO_read_ASCII, &
IO_error, &
IO_open_file_stat, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_lc, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_timeStamp, &
IO_EOF
IO_warning
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
use petscsys
#endif
!$ use OMP_LIB, only: omp_set_num_threads
implicit none
integer(pInt), parameter :: FILEUNIT = 300_pInt
!$ integer :: gotDAMASK_NUM_THREADS = 1
integer :: i, ierr ! no pInt
integer :: i,j, ierr ! no pInt
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: &
character(len=pStringLen), dimension(:), allocatable :: fileContent
character(len=pStringLen) :: &
tag ,&
line
logical :: fexist
!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS
#ifdef PETSc
@ -186,18 +184,18 @@ subroutine numerics_init
!$ if (DAMASK_NumThreadsInt < 1_4) DAMASK_NumThreadsInt = 1_4 ! in case of string conversion fails, set it to one
!$ endif
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution
!--------------------------------------------------------------------------------------------------
! try to open the config file
fileExists: if(IO_open_file_stat(FILEUNIT,numerics_configFile)) then
inquire(file='numerics.config', exist=fexist)
fileExists: if (fexist) then
write(6,'(a,/)') ' using values from config file'
flush(6)
fileContent = IO_read_ASCII('numerics.config')
do j=1, size(fileContent)
!--------------------------------------------------------------------------------------------------
! read variables from config file and overwrite default parameters if keyword is present
line = ''
do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(FILEUNIT)
line = fileContent(j)
do i=1,len(line)
if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version
enddo
@ -377,15 +375,14 @@ subroutine numerics_init
case ('bbarstabilisation')
BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
#else
case ('integrationorder','structorder','thermalorder', 'damageorder','vacancyfluxorder', &
'porosityorder','hydrogenfluxorder','bbarstabilisation')
case ('integrationorder','structorder','thermalorder', 'damageorder', &
'bbarstabilisation')
call IO_warning(40_pInt,ext_msg=tag)
#endif
case default ! found unknown keyword
call IO_error(300_pInt,ext_msg=tag)
end select
enddo
close(FILEUNIT)
else fileExists
write(6,'(a,/)') ' using standard values'

45
src/plastic_disloUCLA.f90
View File

@ -102,7 +102,8 @@ module plastic_disloUCLA
plastic_disloUCLA_dependentState, &
plastic_disloUCLA_LpAndItsTangent, &
plastic_disloUCLA_dotState, &
plastic_disloUCLA_postResults
plastic_disloUCLA_postResults, &
plastic_disloUCLA_results
private :: &
kinetics
@ -114,11 +115,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
@ -128,8 +124,7 @@ subroutine plastic_disloUCLA_init()
use math, only: &
math_expand
use IO, only: &
IO_error, &
IO_timeStamp
IO_error
use material, only: &
phase_plasticity, &
phase_plasticityInstance, &
@ -140,7 +135,6 @@ subroutine plastic_disloUCLA_init()
material_phase, &
plasticState
use config, only: &
MATERIAL_partPhase, &
config_phase
use lattice
@ -165,10 +159,9 @@ subroutine plastic_disloUCLA_init()
outputs
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_label//' init -+>>>'
write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256'
write(6,'(/,a)') ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78:242–256, 2016'
write(6,'(a)') ' https://dx.doi.org/10.1016/j.ijplas.2015.09.002'
Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
@ -569,6 +562,32 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe
end function plastic_disloUCLA_postResults
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_results(instance,group)
#if defined(PETSc) || defined(DAMASKHDF5)
use results
implicit none
integer, intent(in) :: instance
character(len=*) :: group
integer :: o
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
end select
enddo outputsLoop
end associate
#else
integer, intent(in) :: instance
character(len=*) :: group
#endif
end subroutine plastic_disloUCLA_results
!--------------------------------------------------------------------------------------------------
!> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the
! resolved stresss

66
src/plastic_dislotwin.f90
View File

@ -168,7 +168,8 @@ module plastic_dislotwin
plastic_dislotwin_dependentState, &
plastic_dislotwin_LpAndItsTangent, &
plastic_dislotwin_dotState, &
plastic_dislotwin_postResults
plastic_dislotwin_postResults, &
plastic_dislotwin_results
private :: &
kinetics_slip, &
kinetics_twin, &
@ -182,11 +183,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_dislotwin_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen, &
dEq0, &
@ -200,9 +196,7 @@ subroutine plastic_dislotwin_init
math_expand,&
PI
use IO, only: &
IO_warning, &
IO_error, &
IO_timeStamp
IO_error
use material, only: &
phase_plasticity, &
phase_plasticityInstance, &
@ -213,7 +207,6 @@ subroutine plastic_dislotwin_init
material_phase, &
plasticState
use config, only: &
MATERIAL_partPhase, &
config_phase
use lattice
@ -238,16 +231,17 @@ subroutine plastic_dislotwin_init
outputs
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>'
write(6,'(/,a)') ' A. Ma and F. Roters, Acta Materialia, 52(12):3603–3612, 2004'
write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2004.04.012'
write(6,'(/,a)') ' F.Roters et al., Computational Materials Science, 39:91–95, 2007'
write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014'
write(6,'(/,a)') ' Wong et al., Acta Materialia, 118:140–151, 2016'
write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOTWIN_ID),pInt)
write(6,'(/,a)') ' Ma and Roters, Acta Materialia 52(12):3603–3612, 2004'
write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2004.04.012'
write(6,'(/,a)') ' Roters et al., Computational Materials Science 39:91–95, 2007'
write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014'
write(6,'(/,a)') ' Wong et al., Acta Materialia 118:140–151, 2016'
write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032'
Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
@ -681,7 +675,7 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,
dNeq0
use math, only: &
math_eigenValuesVectorsSym, &
math_tensorproduct33, &
math_outer, &
math_symmetric33, &
math_mul33xx33, &
math_mul33x3
@ -755,8 +749,8 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,
call math_eigenValuesVectorsSym(Mp,eigValues,eigVectors,error)
do i = 1_pInt,6_pInt
Schmid_shearBand = 0.5_pReal * math_tensorproduct33(math_mul33x3(eigVectors,sb_sComposition(1:3,i)),&
math_mul33x3(eigVectors,sb_mComposition(1:3,i)))
Schmid_shearBand = 0.5_pReal * math_outer(math_mul33x3(eigVectors,sb_sComposition(1:3,i)),&
math_mul33x3(eigVectors,sb_mComposition(1:3,i)))
tau = math_mul33xx33(Mp,Schmid_shearBand)
significantShearBandStress: if (abs(tau) > tol_math_check) then
@ -1095,6 +1089,32 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe
end function plastic_dislotwin_postResults
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine plastic_dislotwin_results(instance,group)
#if defined(PETSc) || defined(DAMASKHDF5)
use results
implicit none
integer, intent(in) :: instance
character(len=*) :: group
integer :: o
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
end select
enddo outputsLoop
end associate
#else
integer, intent(in) :: instance
character(len=*) :: group
#endif
end subroutine plastic_dislotwin_results
!--------------------------------------------------------------------------------------------------
!> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the
! resolved stresss
@ -1127,7 +1147,7 @@ pure subroutine kinetics_slip(Mp,Temperature,instance,of, &
real(pReal), dimension(param(instance)%totalNslip) :: &
dgdot_dtau
real, dimension(param(instance)%totalNslip) :: &
real(pReal), dimension(param(instance)%totalNslip) :: &
tau, &
stressRatio, &
StressRatio_p, &

49
src/plastic_isotropic.f90
View File

@ -68,7 +68,8 @@ module plastic_isotropic
plastic_isotropic_LpAndItsTangent, &
plastic_isotropic_LiAndItsTangent, &
plastic_isotropic_dotState, &
plastic_isotropic_postResults
plastic_isotropic_postResults, &
plastic_isotropic_results
contains
@ -76,12 +77,7 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
subroutine plastic_isotropic_init
use prec, only: &
pStringLen
use debug, only: &
@ -95,8 +91,7 @@ subroutine plastic_isotropic_init()
debug_constitutive, &
debug_levelBasic
use IO, only: &
IO_error, &
IO_timeStamp
IO_error
use material, only: &
#ifdef DEBUG
phasememberAt, &
@ -110,7 +105,6 @@ subroutine plastic_isotropic_init()
material_phase, &
plasticState
use config, only: &
MATERIAL_partPhase, &
config_phase
use lattice
@ -132,12 +126,11 @@ subroutine plastic_isotropic_init()
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"
Ninstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
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'
Ninstance = count(phase_plasticity == PLASTICITY_ISOTROPIC_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
@ -490,4 +483,30 @@ function plastic_isotropic_postResults(Mp,instance,of) result(postResults)
end function plastic_isotropic_postResults
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_results(instance,group)
#if defined(PETSc) || defined(DAMASKHDF5)
use results
implicit none
integer, intent(in) :: instance
character(len=*) :: group
integer :: o
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
end select
enddo outputsLoop
end associate
#else
integer, intent(in) :: instance
character(len=*) :: group
#endif
end subroutine plastic_isotropic_results
end module plastic_isotropic

44
src/plastic_kinematichardening.f90
View File

@ -83,7 +83,8 @@ module plastic_kinehardening
plastic_kinehardening_LpAndItsTangent, &
plastic_kinehardening_dotState, &
plastic_kinehardening_deltaState, &
plastic_kinehardening_postResults
plastic_kinehardening_postResults, &
plastic_kinehardening_results
private :: &
kinetics
@ -95,11 +96,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
dEq0, &
pStringLen
@ -116,8 +112,7 @@ subroutine plastic_kinehardening_init
use math, only: &
math_expand
use IO, only: &
IO_error, &
IO_timeStamp
IO_error
use material, only: &
#ifdef DEBUG
phasememberAt, &
@ -131,7 +126,6 @@ subroutine plastic_kinehardening_init
material_phase, &
plasticState
use config, only: &
MATERIAL_partPhase, &
config_phase
use lattice
@ -156,11 +150,9 @@ subroutine plastic_kinehardening_init
outputs
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
Ninstance = int(count(phase_plasticity == PLASTICITY_KINEHARDENING_ID),pInt)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
Ninstance = count(phase_plasticity == PLASTICITY_KINEHARDENING_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(plastic_kinehardening_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
@ -557,6 +549,32 @@ function plastic_kinehardening_postResults(Mp,instance,of) result(postResults)
end function plastic_kinehardening_postResults
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_results(instance,group)
#if defined(PETSc) || defined(DAMASKHDF5)
use results
implicit none
integer, intent(in) :: instance
character(len=*) :: group
integer :: o
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
end select
enddo outputsLoop
end associate
#else
integer, intent(in) :: instance
character(len=*) :: group
#endif
end subroutine plastic_kinehardening_results
!--------------------------------------------------------------------------------------------------
!> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress
!> @details: Shear rates are calculated only optionally.

73
src/plastic_nonlocal.f90
View File

@ -32,12 +32,6 @@ module plastic_nonlocal
integer(pInt), dimension(:), allocatable, public, protected :: &
totalNslip !< total number of active slip systems for each instance
integer(pInt), dimension(:,:), allocatable, private :: &
Nslip, & !< number of active slip systems
slipFamily !< lookup table relating active slip system to slip family for each instance
real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: &
compatibility !< slip system compatibility between me and my neighbors
@ -228,7 +222,8 @@ module plastic_nonlocal
plastic_nonlocal_dotState, &
plastic_nonlocal_deltaState, &
plastic_nonlocal_updateCompatibility, &
plastic_nonlocal_postResults
plastic_nonlocal_postResults, &
plastic_nonlocal_results
private :: &
plastic_nonlocal_kinetics
@ -290,8 +285,14 @@ subroutine plastic_nonlocal_init
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>'
maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(/,a)') ' Reuber et al., Acta Materialia 71:333–348, 2014'
write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2014.03.012'
write(6,'(/,a)') ' Kords, Dissertation RWTH Aachen, 2014'
write(6,'(a)') ' http://publications.rwth-aachen.de/record/229993'
maxNinstances = count(phase_plasticity == PLASTICITY_NONLOCAL_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances
@ -306,8 +307,6 @@ subroutine plastic_nonlocal_init
allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances))
plastic_nonlocal_output = ''
allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID)
allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt)
allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt)
allocate(totalNslip(maxNinstances), source=0_pInt)
@ -598,8 +597,7 @@ extmsg = trim(extmsg)//' fEdgeMultiplication'
plasticState(p)%offsetDeltaState = 0_pInt ! ToDo: state structure does not follow convention
plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(p)))
Nslip(1:size(prm%Nslip),phase_plasticityInstance(p)) = prm%Nslip ! ToDo: DEPRECATED
totalNslip(phase_plasticityInstance(p)) = sum(Nslip(1:size(prm%Nslip),phase_plasticityInstance(p))) ! ToDo: DEPRECATED
totalNslip(phase_plasticityInstance(p)) = prm%totalNslip
! ToDo: Not really sure if this large number of mostly overlapping pointers is useful
stt%rho => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:)
@ -1378,7 +1376,7 @@ dv_dtau(1:ns,2) = dv_dtau(1:ns,1)
dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1)
!screws
if (size(prm%nonSchmidCoeff) == 0_pInt) then ! no non-Schmid contributions
if (size(prm%nonSchmidCoeff) == 0_pInt) then ! no non-Schmid contributions
forall(t = 3_pInt:4_pInt)
v(1:ns,t) = v(1:ns,1)
dv_dtau(1:ns,t) = dv_dtau(1:ns,1)
@ -1548,13 +1546,13 @@ dUpper(1:ns,1) = prm%mu * prm%burgers &
dUpper(1:ns,2) = prm%mu * prm%burgers / (4.0_pReal * PI * abs(tau))
forall (c = 1_pInt:2_pInt)
do c = 1, 2
where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))&
+abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) &
dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) &
+ abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), &
dUpper(1:ns,c))
end forall
enddo
dUpper = max(dUpper,dLower)
deltaDUpper = dUpper - dUpperOld
@ -1626,6 +1624,10 @@ use debug, only: debug_level, &
debug_e
#endif
use math, only: math_mul3x3, &
#ifdef __PGI
norm2, &
#endif
math_mul33x3, &
math_mul33xx33, &
math_mul33x33, &
@ -1804,13 +1806,13 @@ dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) &
/ (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau))
dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) &
/ (4.0_pReal * pi * abs(tau))
forall (c = 1_pInt:2_pInt)
do c = 1, 2
where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))&
+abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) &
dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) &
+ abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), &
dUpper(1:ns,c))
end forall
enddo
dUpper = max(dUpper,dLower)
!****************************************************************************
@ -1862,7 +1864,7 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then
endif
!*** be aware of the definition of lattice_st = lattice_sd x lattice_sn !!!
!*** be aware of the definition of slip_transverse = slip_direction x slip_normal !!!
!*** opposite sign to our p vector in the (s,p,n) triplet !!!
m(1:3,1:ns,1) = prm%slip_direction
@ -2148,8 +2150,7 @@ use rotations, only: rotation
use material, only: material_phase, &
material_texture, &
phase_localPlasticity, &
phase_plasticityInstance, &
homogenization_maxNgrains
phase_plasticityInstance
use mesh, only: mesh_ipNeighborhood, &
theMesh
use lattice, only: lattice_qDisorientation
@ -2385,13 +2386,13 @@ dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) &
/ (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau))
dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) &
/ (4.0_pReal * pi * abs(tau))
forall (c = 1_pInt:2_pInt)
do c = 1, 2
where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))&
+abs(rhoSgl(1:ns,2*c+4))+rhoDip(1:ns,c)))) &
dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) &
+ abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), &
dUpper(1:ns,c))
end forall
enddo
dUpper = max(dUpper,dLower)
@ -2562,4 +2563,30 @@ enddo outputsLoop
end associate
end function plastic_nonlocal_postResults
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_results(instance,group)
#if defined(PETSc) || defined(DAMASKHDF5)
use results
implicit none
integer, intent(in) :: instance
character(len=*) :: group
integer :: o
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
select case(prm%outputID(o))
end select
enddo outputsLoop
end associate
#else
integer, intent(in) :: instance
character(len=*) :: group
#endif
end subroutine plastic_nonlocal_results
end module plastic_nonlocal

23
src/plastic_phenopowerlaw.f90
View File

@ -107,11 +107,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_phenopowerlaw_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
@ -121,8 +116,7 @@ subroutine plastic_phenopowerlaw_init
use math, only: &
math_expand
use IO, only: &
IO_error, &
IO_timeStamp
IO_error
use material, only: &
phase_plasticity, &
phase_plasticityInstance, &
@ -133,7 +127,6 @@ subroutine plastic_phenopowerlaw_init
material_phase, &
plasticState
use config, only: &
MATERIAL_partPhase, &
config_phase
use lattice
@ -158,14 +151,12 @@ subroutine plastic_phenopowerlaw_init
outputs
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
Ninstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
Ninstance = count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),Ninstance))
plastic_phenopowerlaw_output = ''
@ -584,9 +575,9 @@ subroutine plastic_phenopowerlaw_results(instance,group)
use results
implicit none
integer(pInt), intent(in) :: instance
integer, intent(in) :: instance
character(len=*) :: group
integer(pInt) :: o
integer :: o
associate(prm => param(instance), stt => state(instance))
outputsLoop: do o = 1_pInt,size(prm%outputID)
@ -599,7 +590,7 @@ subroutine plastic_phenopowerlaw_results(instance,group)
enddo outputsLoop
end associate
#else
integer(pInt), intent(in) :: instance
integer, intent(in) :: instance
character(len=*) :: group
#endif
end subroutine plastic_phenopowerlaw_results

66
src/prec.f90
View File

@ -9,9 +9,9 @@
module prec
use, intrinsic :: IEEE_arithmetic, only:&
IEEE_selected_real_kind
implicit none
private
private
! https://software.intel.com/en-us/blogs/2017/03/27/doctor-fortran-in-it-takes-all-kinds
integer, parameter, public :: pReal = IEEE_selected_real_kind(15,307) !< number with 15 significant digits, up to 1e+-307 (typically 64 bit)
@ -31,20 +31,20 @@ module prec
end type group_float
type, public :: group_int
integer(pInt), dimension(:), pointer :: p
integer, dimension(:), pointer :: p
end type group_int
! http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array
type, public :: tState
integer(pInt) :: &
sizeState = 0_pInt, & !< size of state
sizeDotState = 0_pInt, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates
offsetDeltaState = 0_pInt, & !< index offset of delta state
sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments
sizePostResults = 0_pInt !< size of output data
integer :: &
sizeState = 0, & !< size of state
sizeDotState = 0, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates
offsetDeltaState = 0, & !< index offset of delta state
sizeDeltaState = 0, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments
sizePostResults = 0 !< size of output data
real(pReal), pointer, dimension(:), contiguous :: &
atolState
real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous
real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous
state0, &
state, & !< state
dotState, & !< rate of state change
@ -60,11 +60,11 @@ module prec
end type
type, extends(tState), public :: tPlasticState
integer(pInt) :: &
nSlip = 0_pInt , &
nTwin = 0_pInt, &
nTrans = 0_pInt
logical :: &
integer :: &
nSlip = 0, &
nTwin = 0, &
nTrans = 0
logical :: &
nonlocal = .false.
real(pReal), pointer, dimension(:,:) :: &
slipRate, & !< slip rate
@ -74,12 +74,12 @@ module prec
type, public :: tSourceState
type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase
end type
type, public :: tHomogMapping
integer(pInt), pointer, dimension(:,:) :: p
end type
real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0.
type, public :: tHomogMapping
integer, pointer, dimension(:,:) :: p
end type
real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0.
real(pReal), private, parameter :: PREAL_MIN = tiny(0.0_pReal) !< smallest normalized floating point number
public :: &
@ -90,7 +90,7 @@ module prec
dNeq, &
dNeq0, &
cNeq
contains
@ -100,23 +100,23 @@ contains
subroutine prec_init
implicit none
integer(pInt), allocatable, dimension(:) :: realloc_lhs_test
integer, allocatable, dimension(:) :: realloc_lhs_test
external :: &
quit
write(6,'(/,a)') ' <<<+- prec init -+>>>'
write(6,'(a,i3)') ' Size of integer in bit: ',bit_size(0_pInt)
write(6,'(a,i19)') ' Maximum value: ',huge(0_pInt)
write(6,'(a,i3)') ' Size of integer in bit: ',bit_size(0)
write(6,'(a,i19)') ' Maximum value: ',huge(0)
write(6,'(/,a,i3)') ' Size of float in bit: ',storage_size(0.0_pReal)
write(6,'(a,e10.3)') ' Maximum value: ',huge(0.0_pReal)
write(6,'(a,e10.3)') ' Minimum value: ',tiny(0.0_pReal)
write(6,'(a,i3)') ' Decimal precision: ',precision(0.0_pReal)
realloc_lhs_test = [1_pInt,2_pInt]
if (realloc_lhs_test(2)/=2_pInt) call quit(9000)
realloc_lhs_test = [1,2]
if (realloc_lhs_test(2)/=2) call quit(9000)
end subroutine prec_init
@ -132,7 +132,7 @@ logical elemental pure function dEq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -156,7 +156,7 @@ logical elemental pure function dNeq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -180,7 +180,7 @@ logical elemental pure function dEq0(a,tol)
real(pReal), intent(in) :: a
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -204,7 +204,7 @@ logical elemental pure function dNeq0(a,tol)
real(pReal), intent(in) :: a
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -229,7 +229,7 @@ logical elemental pure function cEq(a,b,tol)
complex(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -254,7 +254,7 @@ logical elemental pure function cNeq(a,b,tol)
complex(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else

12
src/quaternions.f90
View File

@ -354,6 +354,10 @@ end function pow_quat__
!> ToDo: Lacks any check for invalid operations
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental function exp__(self)
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none
class(quaternion), intent(in) :: self
@ -374,6 +378,10 @@ end function exp__
!> ToDo: Lacks any check for invalid operations
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental function log__(self)
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none
class(quaternion), intent(in) :: self
@ -393,6 +401,10 @@ end function log__
!> norm of a quaternion
!---------------------------------------------------------------------------------------------------
real(pReal) elemental function abs__(a)
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none
class(quaternion), intent(in) :: a

45
src/results.f90
View File

@ -13,35 +13,36 @@ module results
use PETSC
#endif
implicit none
private
integer(HID_T), public, protected :: tempCoordinates, tempResults
integer(HID_T), private :: resultsFile, currentIncID, plist_id
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
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
use DAMASK_interface, only: &
getSolverJobName
write(6,'(/,a)') ' <<<+- results init -+>>>'
#include "compilation_info.f90"
implicit none
call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.))
write(6,'(/,a)') ' <<<+- results init -+>>>'
write(6,'(/,a)') ' Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017'
write(6,'(a)') ' https://doi.org/10.1007/s40192-018-0118-7'
call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.))
end subroutine results_init

28
src/rotations.f90
View File

@ -157,6 +157,10 @@ end subroutine
function rotVector(self,v,active)
use prec, only: &
dEq
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none
real(pReal), dimension(3) :: rotVector
@ -552,14 +556,8 @@ function om2ax(om) result(ax)
LWORK = 20
! call the eigenvalue solver
#if (FLOAT==8)
call dgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO)
#elif (FLOAT==4)
call sgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO)
#else
NO SUITABLE PRECISION FOR REAL SELECTED, STOPPING COMPILATION
#endif
if (INFO /= 0) call IO_error(0_pInt,ext_msg='Error in om2ax/(s/d)geev: (S/D)GEEV return not zero')
if (INFO /= 0) call IO_error(0_pInt,ext_msg='Error in om2ax DGEEV return not zero')
i = maxloc(merge(1.0_pReal,0.0_pReal,cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal)),dim=1) ! poor substitute for findloc
ax(1:3) = VR(1:3,i)
where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) &
@ -579,6 +577,9 @@ pure function ro2ax(ro) result(ax)
use prec, only: &
dEq0
use math, only: &
#ifdef __PGI
norm2, &
#endif
PI
implicit none
@ -668,6 +669,9 @@ pure function ro2ho(ro) result(ho)
use prec, only: &
dEq0
use math, only: &
#ifdef __PGI
norm2, &
#endif
PI
implicit none
@ -724,6 +728,10 @@ end function qu2om
function om2qu(om) result(qu)
use prec, only: &
dEq
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none
real(pReal), intent(in), dimension(3,3) :: om
@ -797,6 +805,9 @@ pure function qu2ro(qu) result(ro)
use prec, only: &
dEq0
use math, only: &
#ifdef __PGI
norm2, &
#endif
math_clip
type(quaternion), intent(in) :: qu
@ -825,6 +836,9 @@ pure function qu2ho(qu) result(ho)
use prec, only: &
dEq0
use math, only: &
#ifdef __PGI
norm2, &
#endif
math_clip
implicit none

13
src/source_damage_anisoBrittle.f90
View File

@ -63,11 +63,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoBrittle_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
@ -89,8 +84,7 @@ subroutine source_damage_anisoBrittle_init
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
material_Nphase
use lattice, only: &
lattice_maxNcleavageFamily
@ -109,7 +103,6 @@ subroutine source_damage_anisoBrittle_init
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>'
#include "compilation_info.f90"
Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt)
if (Ninstance == 0_pInt) return
@ -212,7 +205,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
sourceState, &
material_homog, &
material_homogenizationAt, &
damage, &
damageMapping
use lattice, only: &
@ -242,7 +235,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_anisoBrittle_instance(phase)
sourceOffset = source_damage_anisoBrittle_offset(phase)
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal

57
src/source_damage_anisoDuctile.f90
View File

@ -22,9 +22,6 @@ module source_damage_anisoDuctile
source_damage_anisoDuctile_output !< name of each post result output
integer(pInt), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_Nslip !< number of slip systems per family
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
@ -37,9 +34,9 @@ module source_damage_anisoDuctile
N
real(pReal), dimension(:), allocatable :: &
critPlasticStrain
integer(pInt) :: &
integer :: &
totalNslip
integer(pInt), dimension(:), allocatable :: &
integer, dimension(:), allocatable :: &
Nslip
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
@ -62,11 +59,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
@ -75,7 +67,7 @@ subroutine source_damage_anisoDuctile_init
debug_levelBasic
use IO, only: &
IO_error
use math, only: &
use math, only: &
math_expand
use material, only: &
material_allocateSourceState, &
@ -87,14 +79,10 @@ subroutine source_damage_anisoDuctile_init
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
use lattice, only: &
lattice_maxNslipFamily
config_phase
implicit none
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p ,i
@ -109,17 +97,16 @@ subroutine source_damage_anisoDuctile_init
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>'
#include "compilation_info.f90"
Ninstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt)
Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID)
if (Ninstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(source_damage_anisoDuctile_offset(material_Nphase), source=0_pInt)
allocate(source_damage_anisoDuctile_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0_pInt)
allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0_pInt)
do phase = 1, size(config_phase)
source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID)
do source = 1, phase_Nsources(phase)
if (phase_source(source,phase) == source_damage_anisoDuctile_ID) &
@ -131,7 +118,6 @@ subroutine source_damage_anisoDuctile_init
allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance))
source_damage_anisoDuctile_output = ''
allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt)
allocate(param(Ninstance))
@ -143,7 +129,7 @@ subroutine source_damage_anisoDuctile_init
prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal)
prm%N = config%getFloat('anisoductile_ratesensitivity')
prm%totalNslip = sum(prm%Nslip)
! sanity checks
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol'
@ -192,8 +178,6 @@ subroutine source_damage_anisoDuctile_init
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
source_damage_anisoDuctile_Nslip(1:size(param(instance)%Nslip),instance) = param(instance)%Nslip
enddo
end subroutine source_damage_anisoDuctile_init
@ -206,11 +190,9 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
phaseAt, phasememberAt, &
plasticState, &
sourceState, &
material_homog, &
material_homogenizationAt, &
damage, &
damageMapping
use lattice, only: &
lattice_maxNslipFamily
implicit none
integer(pInt), intent(in) :: &
@ -223,26 +205,21 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
sourceOffset, &
homog, damageOffset, &
instance, &
index, f, i
f, i
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_anisoDuctile_instance(phase)
sourceOffset = source_damage_anisoDuctile_offset(phase)
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
index = 1_pInt
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
do f = 1_pInt,lattice_maxNslipFamily
do i = 1_pInt,source_damage_anisoDuctile_Nslip(f,instance) ! process each (active) slip system in family
do i = 1, param(instance)%totalNslip
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + &
plasticState(phase)%slipRate(index,constituent)/ &
((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(index)
index = index + 1_pInt
enddo
plasticState(phase)%slipRate(i,constituent)/ &
((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(i)
enddo
end subroutine source_damage_anisoDuctile_dotState

9
src/source_damage_isoBrittle.f90
View File

@ -53,11 +53,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
@ -77,8 +72,7 @@ subroutine source_damage_isoBrittle_init
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
material_Nphase
implicit none
@ -94,7 +88,6 @@ subroutine source_damage_isoBrittle_init
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'
#include "compilation_info.f90"
Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt)
if (Ninstance == 0_pInt) return

18
src/source_damage_isoDuctile.f90
View File

@ -53,11 +53,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
@ -65,7 +60,6 @@ subroutine source_damage_isoDuctile_init
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_warning, &
IO_error
use material, only: &
material_allocateSourceState, &
@ -78,8 +72,7 @@ subroutine source_damage_isoDuctile_init
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
material_Nphase
implicit none
@ -95,12 +88,11 @@ subroutine source_damage_isoDuctile_init
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>'
#include "compilation_info.f90"
Ninstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt)
Ninstance = count(phase_source == SOURCE_damage_isoDuctile_ID)
if (Ninstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt)
@ -181,7 +173,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
phaseAt, phasememberAt, &
plasticState, &
sourceState, &
material_homog, &
material_homogenizationAt, &
damage, &
damageMapping
@ -197,7 +189,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_isoDuctile_instance(phase)
sourceOffset = source_damage_isoDuctile_offset(phase)
homog = material_homog(ip,el)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &

5
src/source_thermal_dissipation.f90
View File

@ -60,8 +60,7 @@ subroutine source_thermal_dissipation_init
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
material_Nphase
implicit none
integer(pInt) :: Ninstance,instance,source,sourceOffset
@ -106,7 +105,7 @@ end subroutine source_thermal_dissipation_init
!--------------------------------------------------------------------------------------------------
!> @brief returns local vacancy generation rate
!> @brief returns dissipation rate
!--------------------------------------------------------------------------------------------------
subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar, Lp, phase)

3
src/source_thermal_externalheat.f90
View File

@ -62,8 +62,7 @@ subroutine source_thermal_externalheat_init
SOURCE_thermal_externalheat_ID
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
material_Nphase
implicit none

285
src/spectral_damage.f90
View File

@ -11,14 +11,9 @@ module spectral_damage
use prec, only: &
pInt, &
pReal
use math, only: &
math_I3
use spectral_utilities, only: &
tSolutionState, &
tSolutionParams
use numerics, only: &
worldrank, &
worldsize
implicit none
private
@ -42,7 +37,7 @@ module spectral_damage
!--------------------------------------------------------------------------------------------------
! reference diffusion tensor, mobility etc.
integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment
integer(pInt), private :: totalIter = 0 !< total iteration in current increment
real(pReal), dimension(3,3), private :: D_ref
real(pReal), private :: mobility_ref
@ -57,102 +52,95 @@ contains
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine spectral_damage_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_intOut, &
IO_read_realFile, &
IO_timeStamp
use spectral_utilities, only: &
wgt
use mesh, only: &
grid, &
grid3
use damage_nonlocal, only: &
damage_nonlocal_getDiffusion33, &
damage_nonlocal_getMobility
implicit none
PetscInt, dimension(:), allocatable :: localK
integer(pInt) :: proc
integer(pInt) :: i, j, k, cell
DM :: damage_grid
Vec :: uBound, lBound
PetscErrorCode :: ierr
character(len=100) :: snes_type
use IO, only: &
IO_intOut
use spectral_utilities, only: &
wgt
use mesh, only: &
grid, &
grid3
use damage_nonlocal, only: &
damage_nonlocal_getDiffusion33, &
damage_nonlocal_getMobility
use numerics, only: &
worldrank, &
worldsize
implicit none
PetscInt, dimension(worldsize) :: localK
integer :: i, j, k, cell
DM :: damage_grid
Vec :: uBound, lBound
PetscErrorCode :: ierr
character(len=100) :: snes_type
write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>'
write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press, '
write(6,'(a,/)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 '
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019'
write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80'
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr)
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
do proc = 1, worldsize
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
enddo
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & !< cut off stencil at boundary
DMDA_STENCIL_BOX, & !< Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & !< global grid
1, 1, worldsize, &
1, 0, & !< #dof (damage phase field), ghost boundary width (domain overlap)
[grid(1)],[grid(2)],localK, & !< local grid
damage_grid,ierr) !< handle, error
CHKERRQ(ierr)
call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da
call DMsetFromOptions(damage_grid,ierr); CHKERRQ(ierr)
call DMsetUp(damage_grid,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,&
PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional CLI arguments
call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr)
if (trim(snes_type) == 'vinewtonrsls' .or. &
trim(snes_type) == 'vinewtonssls') then
call DMGetGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr)
call DMGetGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr)
call VecSet(lBound,0.0_pReal,ierr); CHKERRQ(ierr)
call VecSet(uBound,1.0_pReal,ierr); CHKERRQ(ierr)
call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr) !< variable bounds for variational inequalities like contact mechanics, damage etc.
call DMRestoreGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr)
call DMRestoreGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr)
endif
call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr)
localK = 0
localK(worldrank+1) = grid3
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & !< cut off stencil at boundary
DMDA_STENCIL_BOX, & !< Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & !< global grid
1, 1, worldsize, &
1, 0, & !< #dof (damage phase field), ghost boundary width (domain overlap)
[grid(1)],[grid(2)],localK, & !< local grid
damage_grid,ierr) !< handle, error
CHKERRQ(ierr)
call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da
call DMsetFromOptions(damage_grid,ierr); CHKERRQ(ierr)
call DMsetUp(damage_grid,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,&
PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional CLI arguments
call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr)
if (trim(snes_type) == 'vinewtonrsls' .or. &
trim(snes_type) == 'vinewtonssls') then
call DMGetGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr)
call DMGetGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr)
call VecSet(lBound,0.0_pReal,ierr); CHKERRQ(ierr)
call VecSet(uBound,1.0_pReal,ierr); CHKERRQ(ierr)
call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr) !< variable bounds for variational inequalities like contact mechanics, damage etc.
call DMRestoreGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr)
call DMRestoreGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr)
endif
!--------------------------------------------------------------------------------------------------
! init fields
call DMDAGetCorners(damage_grid,xstart,ystart,zstart,xend,yend,zend,ierr)
CHKERRQ(ierr)
xend = xstart + xend - 1
yend = ystart + yend - 1
zend = zstart + zend - 1
call VecSet(solution,1.0_pReal,ierr); CHKERRQ(ierr)
allocate(damage_current(grid(1),grid(2),grid3), source=1.0_pReal)
allocate(damage_lastInc(grid(1),grid(2),grid3), source=1.0_pReal)
allocate(damage_stagInc(grid(1),grid(2),grid3), source=1.0_pReal)
call DMDAGetCorners(damage_grid,xstart,ystart,zstart,xend,yend,zend,ierr)
CHKERRQ(ierr)
xend = xstart + xend - 1
yend = ystart + yend - 1
zend = zstart + zend - 1
call VecSet(solution,1.0_pReal,ierr); CHKERRQ(ierr)
allocate(damage_current(grid(1),grid(2),grid3), source=1.0_pReal)
allocate(damage_lastInc(grid(1),grid(2),grid3), source=1.0_pReal)
allocate(damage_stagInc(grid(1),grid(2),grid3), source=1.0_pReal)
!--------------------------------------------------------------------------------------------------
! damage reference diffusion update
cell = 0_pInt
D_ref = 0.0_pReal
mobility_ref = 0.0_pReal
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt
D_ref = D_ref + damage_nonlocal_getDiffusion33(1,cell)
mobility_ref = mobility_ref + damage_nonlocal_getMobility(1,cell)
enddo; enddo; enddo
D_ref = D_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
mobility_ref = mobility_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
cell = 0_pInt
D_ref = 0.0_pReal
mobility_ref = 0.0_pReal
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
D_ref = D_ref + damage_nonlocal_getDiffusion33(1,cell)
mobility_ref = mobility_ref + damage_nonlocal_getMobility(1,cell)
enddo; enddo; enddo
D_ref = D_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
mobility_ref = mobility_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
end subroutine spectral_damage_init
@ -160,74 +148,69 @@ end subroutine spectral_damage_init
!> @brief solution for the spectral damage scheme with internal iterations
!--------------------------------------------------------------------------------------------------
type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadCaseTime)
use numerics, only: &
itmax, &
err_damage_tolAbs, &
err_damage_tolRel
use mesh, only: &
grid, &
grid3
use damage_nonlocal, only: &
damage_nonlocal_putNonLocalDamage
use numerics, only: &
itmax, &
err_damage_tolAbs, &
err_damage_tolRel
use mesh, only: &
grid, &
grid3
use damage_nonlocal, only: &
damage_nonlocal_putNonLocalDamage
implicit none
real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment
loadCaseTime !< remaining time of current load case
implicit none
!--------------------------------------------------------------------------------------------------
! input data for solution
real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment
loadCaseTime !< remaining time of current load case
integer(pInt) :: i, j, k, cell
PetscInt ::position
PetscReal :: minDamage, maxDamage, stagNorm, solnNorm
!--------------------------------------------------------------------------------------------------
! PETSc Data
PetscErrorCode :: ierr
SNESConvergedReason :: reason
integer :: i, j, k, cell
PetscInt ::position
PetscReal :: minDamage, maxDamage, stagNorm, solnNorm
PetscErrorCode :: ierr
SNESConvergedReason :: reason
spectral_damage_solution%converged =.false.
!--------------------------------------------------------------------------------------------------
! set module wide availabe data
params%timeinc = timeinc
params%timeincOld = timeinc_old
call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr)
call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr)
if (reason < 1) then
spectral_damage_solution%converged = .false.
spectral_damage_solution%iterationsNeeded = itmax
else
spectral_damage_solution%converged = .true.
spectral_damage_solution%iterationsNeeded = totalIter
endif
stagNorm = maxval(abs(damage_current - damage_stagInc))
solnNorm = maxval(abs(damage_current))
call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
damage_stagInc = damage_current
spectral_damage_solution%stagConverged = stagNorm < err_damage_tolAbs &
.or. stagNorm < err_damage_tolRel*solnNorm
params%timeinc = timeinc
params%timeincOld = timeinc_old
call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr)
call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr)
if (reason < 1) then
spectral_damage_solution%converged = .false.
spectral_damage_solution%iterationsNeeded = itmax
else
spectral_damage_solution%converged = .true.
spectral_damage_solution%iterationsNeeded = totalIter
endif
stagNorm = maxval(abs(damage_current - damage_stagInc))
solnNorm = maxval(abs(damage_current))
call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
damage_stagInc = damage_current
spectral_damage_solution%stagConverged = stagNorm < err_damage_tolAbs &
.or. stagNorm < err_damage_tolRel*solnNorm
!--------------------------------------------------------------------------------------------------
! updating damage state
cell = 0_pInt !< material point = 0
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt !< material point increase
call damage_nonlocal_putNonLocalDamage(damage_current(i,j,k),1,cell)
enddo; enddo; enddo
call VecMin(solution,position,minDamage,ierr); CHKERRQ(ierr)
call VecMax(solution,position,maxDamage,ierr); CHKERRQ(ierr)
if (spectral_damage_solution%converged) &
write(6,'(/,a)') ' ... nonlocal damage converged .....................................'
write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',&
minDamage, maxDamage, stagNorm
write(6,'(/,a)') ' ==========================================================================='
flush(6)
cell = 0
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
call damage_nonlocal_putNonLocalDamage(damage_current(i,j,k),1,cell)
enddo; enddo; enddo
call VecMin(solution,position,minDamage,ierr); CHKERRQ(ierr)
call VecMax(solution,position,maxDamage,ierr); CHKERRQ(ierr)
if (spectral_damage_solution%converged) &
write(6,'(/,a)') ' ... nonlocal damage converged .....................................'
write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',&
minDamage, maxDamage, stagNorm
write(6,'(/,a)') ' ==========================================================================='
flush(6)
end function spectral_damage_solution

84
src/spectral_mech_Basic.f90
View File

@ -73,16 +73,10 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine basic_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_intOut, &
IO_error, &
IO_read_realFile, &
IO_timeStamp
IO_open_jobFile_binary
use debug, only: &
debug_level, &
debug_spectral, &
@ -114,15 +108,17 @@ subroutine basic_init
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: F
PetscInt, dimension(:), allocatable :: localK
integer(pInt) :: proc
PetscInt, dimension(worldsize) :: localK
integer :: fileUnit
character(len=1024) :: rankStr
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015'
write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012'
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
!--------------------------------------------------------------------------------------------------
! allocate global fields
@ -133,10 +129,9 @@ subroutine basic_init
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
do proc = 1, worldsize
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
enddo
localK = 0
localK(worldrank+1) = grid3
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
@ -166,13 +161,17 @@ subroutine basic_init
'reading values of increment ', restartInc, ' from file'
flush(6)
endif
fileUnit = IO_open_jobFile_binary('F_aimDot')
read(fileUnit) F_aimDot; close(fileUnit)
write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F))
read (777,rec=1) F; close (777)
call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc))
read (777,rec=1) F_lastInc; close (777)
call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot))
read (777,rec=1) F_aimDot; close (777)
fileUnit = IO_open_jobFile_binary('F'//trim(rankStr))
read(fileUnit) F; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr))
read(fileUnit) F_lastInc; close (fileUnit)
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')
@ -198,12 +197,12 @@ subroutine basic_init
write(6,'(/,a,'//IO_intOut(restartInc)//',a)') &
'reading more values of increment ', restartInc, ' from file'
flush(6)
call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg))
read (777,rec=1) C_volAvg; close (777)
call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc))
read (777,rec=1) C_volAvgLastInc; close (777)
call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg))
read (777,rec=1) C_minMaxAvg; close (777)
fileUnit = IO_open_jobFile_binary('C_volAvg')
read(fileUnit) C_volAvg; close(fileUnit)
fileUnit = IO_open_jobFile_binary('C_volAvgLastInv')
read(fileUnit) C_volAvgLastInc; close(fileUnit)
fileUnit = IO_open_jobFile_binary('C_ref')
read(fileUnit) C_minMaxAvg; close(fileUnit)
endif restartRead
call Utilities_updateGamma(C_minMaxAvg,.true.)
@ -450,7 +449,7 @@ subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,s
tBoundaryCondition, &
cutBack
use IO, only: &
IO_write_JobRealFile
IO_open_jobFile_binary
use FEsolving, only: &
restartWrite
@ -468,7 +467,8 @@ subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,s
rotation_BC
PetscErrorCode :: ierr
PetscScalar, dimension(:,:,:,:), pointer :: F
integer :: fileUnit
character(len=32) :: rankStr
call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
@ -483,20 +483,20 @@ subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,s
write(6,'(/,a)') ' writing converged results for restart'
flush(6)
if (worldrank == 0_pInt) then
call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg))
write (777,rec=1) C_volAvg; close(777)
call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc))
write (777,rec=1) C_volAvgLastInc; close(777)
call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot))
write (777,rec=1) F_aimDot; close(777)
if (worldrank == 0) then
fileUnit = IO_open_jobFile_binary('C_volAvg','w')
write(fileUnit) C_volAvg; close(fileUnit)
fileUnit = IO_open_jobFile_binary('C_volAvgLastInv','w')
write(fileUnit) C_volAvgLastInc; close(fileUnit)
fileUnit = IO_open_jobFile_binary('F_aimDot','w')
write(fileUnit) F_aimDot; close(fileUnit)
endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F; close (777)
call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc; close (777)
fileUnit = IO_open_jobFile_binary('F'//trim(rankStr),'w')
write(fileUnit) F; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr),'w')
write(fileUnit) F_lastInc; close (fileUnit)
endif
call CPFEM_age() ! age state and kinematics

101
src/spectral_mech_Polarisation.f90
View File

@ -80,16 +80,10 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine Polarisation_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_intOut, &
IO_error, &
IO_read_realFile, &
IO_timeStamp
IO_open_jobFile_binary
use debug, only: &
debug_level, &
debug_spectral, &
@ -124,15 +118,14 @@ subroutine Polarisation_init
FandF_tau, & ! overall pointer to solution data
F, & ! specific (sub)pointer
F_tau ! specific (sub)pointer
PetscInt, dimension(:), allocatable :: localK
integer(pInt) :: proc
PetscInt, dimension(worldsize) :: localK
integer :: fileUnit
character(len=1024) :: rankStr
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015'
write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
!--------------------------------------------------------------------------------------------------
! allocate global fields
@ -145,10 +138,9 @@ subroutine Polarisation_init
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
do proc = 1, worldsize
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
enddo
localK = 0
localK(worldrank+1) = grid3
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
@ -173,23 +165,28 @@ subroutine Polarisation_init
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) ! places pointer on PETSc data
F => FandF_tau( 0: 8,:,:,:)
F_tau => FandF_tau( 9:17,:,:,:)
restart: if (restartInc > 0_pInt) then
restart: if (restartInc > 0) then
if (iand(debug_level(debug_spectral),debug_spectralRestart) /= 0) then
write(6,'(/,a,'//IO_intOut(restartInc)//',a)') &
'reading values of increment ', restartInc, ' from file'
flush(6)
endif
fileUnit = IO_open_jobFile_binary('F_aimDot')
read(fileUnit) F_aimDot; close(fileUnit)
write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F))
read (777,rec=1) F; close (777)
call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc))
read (777,rec=1) F_lastInc; close (777)
call IO_read_realFile(777,'F_tau'//trim(rankStr),trim(getSolverJobName()),size(F_tau))
read (777,rec=1) F_tau; close (777)
call IO_read_realFile(777,'F_tau_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_tau_lastInc))
read (777,rec=1) F_tau_lastInc; close (777)
call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot))
read (777,rec=1) F_aimDot; close (777)
fileUnit = IO_open_jobFile_binary('F'//trim(rankStr))
read(fileUnit) F; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr))
read(fileUnit) F_lastInc; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_tau'//trim(rankStr))
read(fileUnit) F_tau; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_tau_lastInc'//trim(rankStr))
read(fileUnit) F_tau_lastInc; close (fileUnit)
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')
@ -218,12 +215,12 @@ subroutine Polarisation_init
write(6,'(/,a,'//IO_intOut(restartInc)//',a)') &
'reading more values of increment ', restartInc, ' from file'
flush(6)
call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg))
read (777,rec=1) C_volAvg; close (777)
call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc))
read (777,rec=1) C_volAvgLastInc; close (777)
call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg))
read (777,rec=1) C_minMaxAvg; close (777)
fileUnit = IO_open_jobFile_binary('C_volAvg')
read(fileUnit) C_volAvg; close(fileUnit)
fileUnit = IO_open_jobFile_binary('C_volAvgLastInv')
read(fileUnit) C_volAvgLastInc; close(fileUnit)
fileUnit = IO_open_jobFile_binary('C_ref')
read(fileUnit) C_minMaxAvg; close(fileUnit)
endif restartRead
call Utilities_updateGamma(C_minMaxAvg,.true.)
@ -552,7 +549,7 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati
tBoundaryCondition, &
cutBack
use IO, only: &
IO_write_JobRealFile
IO_open_jobFile_binary
use FEsolving, only: &
restartWrite
@ -572,6 +569,8 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati
PetscScalar, dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau
integer(pInt) :: i, j, k
real(pReal), dimension(3,3) :: F_lambda33
integer :: fileUnit
character(len=32) :: rankStr
!--------------------------------------------------------------------------------------------------
@ -590,24 +589,25 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati
write(6,'(/,a)') ' writing converged results for restart'
flush(6)
if (worldrank == 0_pInt) then
call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg))
write (777,rec=1) C_volAvg; close(777)
call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc))
write (777,rec=1) C_volAvgLastInc; close(777)
call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot))
write (777,rec=1) F_aimDot; close(777)
if (worldrank == 0) then
fileUnit = IO_open_jobFile_binary('C_volAvg','w')
write(fileUnit) C_volAvg; close(fileUnit)
fileUnit = IO_open_jobFile_binary('C_volAvgLastInv','w')
write(fileUnit) C_volAvgLastInc; close(fileUnit)
fileUnit = IO_open_jobFile_binary('F_aimDot','w')
write(fileUnit) F_aimDot; close(fileUnit)
endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F; close (777)
call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc; close (777)
call IO_write_jobRealFile(777,'F_tau'//trim(rankStr),size(F_tau)) ! writing deformation gradient field to file
write (777,rec=1) F_tau; close (777)
call IO_write_jobRealFile(777,'F_tau_lastInc'//trim(rankStr),size(F_tau_lastInc)) ! writing F_tau_lastInc field to file
write (777,rec=1) F_tau_lastInc; close (777)
fileUnit = IO_open_jobFile_binary('F'//trim(rankStr),'w')
write(fileUnit) F; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_lastInc'//trim(rankStr),'w')
write(fileUnit) F_lastInc; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_tau'//trim(rankStr),'w')
write(fileUnit) F_tau; close (fileUnit)
fileUnit = IO_open_jobFile_binary('F_tau_lastInc'//trim(rankStr),'w')
write(fileUnit) F_tau_lastInc; close (fileUnit)
endif
call CPFEM_age() ! age state and kinematics
@ -618,6 +618,7 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati
F_aimDot = merge(stress_BC%maskFloat*(F_aim-F_aim_lastInc)/timeinc_old, 0.0_pReal, guess)
F_aim_lastInc = F_aim
!--------------------------------------------------------------------------------------------------
! calculate rate for aim
if (deformation_BC%myType=='l') then ! calculate F_aimDot from given L and current F

323
src/spectral_thermal.f90
View File

@ -9,16 +9,10 @@ module spectral_thermal
use PETScdmda
use PETScsnes
use prec, only: &
pInt, &
pReal
use math, only: &
math_I3
use spectral_utilities, only: &
tSolutionState, &
tSolutionParams
use numerics, only: &
worldrank, &
worldsize
implicit none
private
@ -42,7 +36,7 @@ module spectral_thermal
!--------------------------------------------------------------------------------------------------
! reference diffusion tensor, mobility etc.
integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment
integer, private :: totalIter = 0 !< total iteration in current increment
real(pReal), dimension(3,3), private :: D_ref
real(pReal), private :: mobility_ref
@ -57,104 +51,97 @@ contains
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine spectral_thermal_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_timeStamp
use spectral_utilities, only: &
wgt
use mesh, only: &
grid, &
grid3
use thermal_conduction, only: &
thermal_conduction_getConductivity33, &
thermal_conduction_getMassDensity, &
thermal_conduction_getSpecificHeat
use material, only: &
mappingHomogenization, &
temperature, &
thermalMapping
implicit none
integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc
integer(pInt) :: i, j, k, cell
DM :: thermal_grid
PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr
use spectral_utilities, only: &
wgt
use mesh, only: &
grid, &
grid3
use thermal_conduction, only: &
thermal_conduction_getConductivity33, &
thermal_conduction_getMassDensity, &
thermal_conduction_getSpecificHeat
use material, only: &
material_homogenizationAt, &
temperature, &
thermalMapping
use numerics, only: &
worldrank, &
worldsize
write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,'
write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
implicit none
integer, dimension(worldsize) :: localK
integer :: i, j, k, cell
DM :: thermal_grid
PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019'
write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80'
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr)
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
do proc = 1, worldsize
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
enddo
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & ! global grid
1, 1, worldsize, &
1, 0, & !< #dof (thermal phase field), ghost boundary width (domain overlap)
[grid(1)],[grid(2)],localK, & !< local grid
thermal_grid,ierr) !< handle, error
CHKERRQ(ierr)
call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da
call DMsetFromOptions(thermal_grid,ierr); CHKERRQ(ierr)
call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,&
PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments
call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr)
localK = 0
localK(worldrank+1) = grid3
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & ! global grid
1, 1, worldsize, &
1, 0, & !< #dof (thermal phase field), ghost boundary width (domain overlap)
[grid(1)],[grid(2)],localK, & !< local grid
thermal_grid,ierr) !< handle, error
CHKERRQ(ierr)
call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da
call DMsetFromOptions(thermal_grid,ierr); CHKERRQ(ierr)
call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,&
PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments
!--------------------------------------------------------------------------------------------------
! init fields
call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr)
CHKERRQ(ierr)
xend = xstart + xend - 1
yend = ystart + yend - 1
zend = zstart + zend - 1
allocate(temperature_current(grid(1),grid(2),grid3), source=0.0_pReal)
allocate(temperature_lastInc(grid(1),grid(2),grid3), source=0.0_pReal)
allocate(temperature_stagInc(grid(1),grid(2),grid3), source=0.0_pReal)
cell = 0_pInt
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt
temperature_current(i,j,k) = temperature(mappingHomogenization(2,1,cell))% &
p(thermalMapping(mappingHomogenization(2,1,cell))%p(1,cell))
temperature_lastInc(i,j,k) = temperature_current(i,j,k)
temperature_stagInc(i,j,k) = temperature_current(i,j,k)
enddo; enddo; enddo
call DMDAVecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with
x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current
call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr)
call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr)
CHKERRQ(ierr)
xend = xstart + xend - 1
yend = ystart + yend - 1
zend = zstart + zend - 1
allocate(temperature_current(grid(1),grid(2),grid3), source=0.0_pReal)
allocate(temperature_lastInc(grid(1),grid(2),grid3), source=0.0_pReal)
allocate(temperature_stagInc(grid(1),grid(2),grid3), source=0.0_pReal)
cell = 0
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
temperature_current(i,j,k) = temperature(material_homogenizationAt(cell))% &
p(thermalMapping(material_homogenizationAt(cell))%p(1,cell))
temperature_lastInc(i,j,k) = temperature_current(i,j,k)
temperature_stagInc(i,j,k) = temperature_current(i,j,k)
enddo; enddo; enddo
call DMDAVecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with
x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current
call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! thermal reference diffusion update
cell = 0_pInt
D_ref = 0.0_pReal
mobility_ref = 0.0_pReal
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt
D_ref = D_ref + thermal_conduction_getConductivity33(1,cell)
mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* &
thermal_conduction_getSpecificHeat(1,cell)
enddo; enddo; enddo
D_ref = D_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
mobility_ref = mobility_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
cell = 0
D_ref = 0.0_pReal
mobility_ref = 0.0_pReal
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
D_ref = D_ref + thermal_conduction_getConductivity33(1,cell)
mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* &
thermal_conduction_getSpecificHeat(1,cell)
enddo; enddo; enddo
D_ref = D_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,D_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
mobility_ref = mobility_ref*wgt
call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
end subroutine spectral_thermal_init
@ -162,76 +149,72 @@ end subroutine spectral_thermal_init
!> @brief solution for the spectral thermal scheme with internal iterations
!--------------------------------------------------------------------------------------------------
type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,loadCaseTime)
use numerics, only: &
itmax, &
err_thermal_tolAbs, &
err_thermal_tolRel
use mesh, only: &
grid, &
grid3
use thermal_conduction, only: &
thermal_conduction_putTemperatureAndItsRate
use numerics, only: &
itmax, &
err_thermal_tolAbs, &
err_thermal_tolRel
use mesh, only: &
grid, &
grid3
use thermal_conduction, only: &
thermal_conduction_putTemperatureAndItsRate
implicit none
implicit none
real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment
loadCaseTime !< remaining time of current load case
integer :: i, j, k, cell
PetscInt :: position
PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm
!--------------------------------------------------------------------------------------------------
! input data for solution
real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment
loadCaseTime !< remaining time of current load case
integer(pInt) :: i, j, k, cell
PetscInt :: position
PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm
PetscErrorCode :: ierr
SNESConvergedReason :: reason
!--------------------------------------------------------------------------------------------------
! PETSc Data
PetscErrorCode :: ierr
SNESConvergedReason :: reason
spectral_thermal_solution%converged =.false.
spectral_thermal_solution%converged =.false.
!--------------------------------------------------------------------------------------------------
! set module wide availabe data
params%timeinc = timeinc
params%timeincOld = timeinc_old
params%timeinc = timeinc
params%timeincOld = timeinc_old
call SNESSolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr)
call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr)
call SNESSolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr)
call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr)
if (reason < 1) then
spectral_thermal_solution%converged = .false.
spectral_thermal_solution%iterationsNeeded = itmax
else
spectral_thermal_solution%converged = .true.
spectral_thermal_solution%iterationsNeeded = totalIter
endif
stagNorm = maxval(abs(temperature_current - temperature_stagInc))
solnNorm = maxval(abs(temperature_current))
call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
temperature_stagInc = temperature_current
spectral_thermal_solution%stagConverged = stagNorm < err_thermal_tolAbs &
.or. stagNorm < err_thermal_tolRel*solnNorm
if (reason < 1) then
spectral_thermal_solution%converged = .false.
spectral_thermal_solution%iterationsNeeded = itmax
else
spectral_thermal_solution%converged = .true.
spectral_thermal_solution%iterationsNeeded = totalIter
endif
stagNorm = maxval(abs(temperature_current - temperature_stagInc))
solnNorm = maxval(abs(temperature_current))
call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
call MPI_Allreduce(MPI_IN_PLACE,solnNorm,1,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr)
temperature_stagInc = temperature_current
spectral_thermal_solution%stagConverged = stagNorm < err_thermal_tolAbs &
.or. stagNorm < err_thermal_tolRel*solnNorm
!--------------------------------------------------------------------------------------------------
! updating thermal state
cell = 0_pInt !< material point = 0
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt !< material point increase
call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), &
(temperature_current(i,j,k)-temperature_lastInc(i,j,k))/params%timeinc, &
1,cell)
enddo; enddo; enddo
cell = 0
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), &
(temperature_current(i,j,k)-temperature_lastInc(i,j,k))/params%timeinc, &
1,cell)
enddo; enddo; enddo
call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr)
call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr)
if (spectral_thermal_solution%converged) &
write(6,'(/,a)') ' ... thermal conduction converged ..................................'
write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
minTemperature, maxTemperature, stagNorm
write(6,'(/,a)') ' ==========================================================================='
flush(6)
call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr)
call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr)
if (spectral_thermal_solution%converged) &
write(6,'(/,a)') ' ... thermal conduction converged ..................................'
write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
minTemperature, maxTemperature, stagNorm
write(6,'(/,a)') ' ==========================================================================='
flush(6)
end function spectral_thermal_solution
@ -272,7 +255,7 @@ subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr)
f_scal
PetscObject :: dummy
PetscErrorCode :: ierr
integer(pInt) :: i, j, k, cell
integer :: i, j, k, cell
real(pReal) :: Tdot, dTdot_dT
temperature_current = x_scal
@ -283,18 +266,18 @@ subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr)
call utilities_FFTscalarForward()
call utilities_fourierScalarGradient() !< calculate gradient of damage field
call utilities_FFTvectorBackward()
cell = 0_pInt
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt
cell = 0
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
vectorField_real(1:3,i,j,k) = math_mul33x3(thermal_conduction_getConductivity33(1,cell) - D_ref, &
vectorField_real(1:3,i,j,k))
enddo; enddo; enddo
call utilities_FFTvectorForward()
call utilities_fourierVectorDivergence() !< calculate damage divergence in fourier field
call utilities_FFTscalarBackward()
cell = 0_pInt
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt
cell = 0
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, temperature_current(i,j,k), 1, cell)
scalarField_real(i,j,k) = params%timeinc*scalarField_real(i,j,k) + &
params%timeinc*Tdot + &
@ -333,10 +316,10 @@ subroutine spectral_thermal_forward()
thermal_conduction_getSpecificHeat
implicit none
integer(pInt) :: i, j, k, cell
DM :: dm_local
PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr
integer :: i, j, k, cell
DM :: dm_local
PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr
if (cutBack) then
temperature_current = temperature_lastInc
@ -344,13 +327,13 @@ subroutine spectral_thermal_forward()
!--------------------------------------------------------------------------------------------------
! reverting thermal field state
cell = 0_pInt !< material point = 0
cell = 0
call SNESGetDM(thermal_snes,dm_local,ierr); CHKERRQ(ierr)
call DMDAVecGetArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with
x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current
call DMDAVecRestoreArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr)
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt !< material point increase
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), &
(temperature_current(i,j,k) - &
temperature_lastInc(i,j,k))/params%timeinc, &
@ -360,11 +343,11 @@ subroutine spectral_thermal_forward()
!--------------------------------------------------------------------------------------------------
! update rate and forward last inc
temperature_lastInc = temperature_current
cell = 0_pInt
cell = 0
D_ref = 0.0_pReal
mobility_ref = 0.0_pReal
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
cell = cell + 1_pInt
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
D_ref = D_ref + thermal_conduction_getConductivity33(1,cell)
mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* &
thermal_conduction_getSpecificHeat(1,cell)

251
src/spectral_utilities.f90
View File

@ -152,8 +152,7 @@ contains
subroutine utilities_init()
use IO, only: &
IO_error, &
IO_warning, &
IO_open_file
IO_warning
use numerics, only: &
spectral_derivative, &
fftw_planner_flag, &
@ -195,8 +194,15 @@ subroutine utilities_init()
tensorSize = 9_C_INTPTR_T
write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>'
write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity, 46:37–53, 2013'
write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2012.09.012'
write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012'
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019'
write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80'
!--------------------------------------------------------------------------------------------------
! set debugging parameters
@ -218,11 +224,11 @@ subroutine utilities_init()
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
CHKERRQ(ierr)
grid1Red = grid(1)/2_pInt + 1_pInt
grid1Red = grid(1)/2 + 1
wgt = 1.0/real(product(grid),pReal)
write(6,'(a,3(i12 ))') ' grid a b c: ', grid
write(6,'(a,3(es12.5))') ' size x y z: ', geomSize
write(6,'(/,a,3(i12 ))') ' grid a b c: ', grid
write(6,'(a,3(es12.5))') ' size x y z: ', geomSize
select case (spectral_derivative)
case ('continuous')
@ -362,62 +368,64 @@ end subroutine utilities_init
!> Also writes out the current reference stiffness for restart.
!--------------------------------------------------------------------------------------------------
subroutine utilities_updateGamma(C,saveReference)
use IO, only: &
IO_write_jobRealFile
use numerics, only: &
memory_efficient, &
worldrank
use mesh, only: &
grid3Offset, &
grid3,&
grid
use math, only: &
math_det33, &
math_invert
implicit none
real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
logical , intent(in) :: saveReference !< save reference stiffness to file for restart
complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx
real(pReal), dimension(6,6) :: matA, matInvA
integer(pInt) :: &
i, j, k, &
l, m, n, o
logical :: err
C_ref = C
if (saveReference) then
if (worldrank == 0_pInt) then
write(6,'(/,a)') ' writing reference stiffness to file'
flush(6)
call IO_write_jobRealFile(777,'C_ref',size(C_ref))
write (777,rec=1) C_ref; close(777)
endif
endif
if(.not. memory_efficient) then
gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A
do k = grid3Offset+1_pInt, grid3Offset+grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red
if (any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset)
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx)
matA(1:3,1:3) = real(temp33_complex); matA(4:6,4:6) = real(temp33_complex)
matA(1:3,4:6) = aimag(temp33_complex); matA(4:6,1:3) = -aimag(temp33_complex)
if (abs(math_det33(matA(1:3,1:3))) > 1e-16) then
call math_invert(6_pInt, matA, matInvA, err)
temp33_complex = cmplx(matInvA(1:3,1:3),matInvA(1:3,4:6),pReal)
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt) &
gamma_hat(l,m,n,o,i,j,k-grid3Offset) = temp33_complex(l,n)* &
use IO, only: &
IO_open_jobFile_binary
use numerics, only: &
memory_efficient, &
worldrank
use mesh, only: &
grid3Offset, &
grid3,&
grid
use math, only: &
math_det33, &
math_invert2
implicit none
real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
logical , intent(in) :: saveReference !< save reference stiffness to file for restart
complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx
real(pReal), dimension(6,6) :: A, A_inv
integer :: &
i, j, k, &
l, m, n, o, &
fileUnit
logical :: err
C_ref = C
if (saveReference) then
if (worldrank == 0_pInt) then
write(6,'(/,a)') ' writing reference stiffness to file'
flush(6)
fileUnit = IO_open_jobFile_binary('C_ref','w')
write(fileUnit) C_ref; close(fileUnit)
endif
endif
if(.not. memory_efficient) then
gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A
do k = grid3Offset+1, grid3Offset+grid3; do j = 1, grid(2); do i = 1, grid1Red
if (any([i,j,k] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
forall(l = 1:3, m = 1:3) &
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset)
forall(l = 1:3, m = 1:3) &
temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx)
A(1:3,1:3) = real(temp33_complex); A(4:6,4:6) = real(temp33_complex)
A(1:3,4:6) = aimag(temp33_complex); A(4:6,1:3) = -aimag(temp33_complex)
if (abs(math_det33(A(1:3,1:3))) > 1e-16) then
call math_invert2(A_inv, err, A)
temp33_complex = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal)
forall(l=1:3, m=1:3, n=1:3, o=1:3) &
gamma_hat(l,m,n,o,i,j,k-grid3Offset) = temp33_complex(l,n)* &
conjg(-xi1st(o,i,j,k-grid3Offset))*xi1st(m,i,j,k-grid3Offset)
endif
endif
enddo; enddo; enddo
endif
endif
endif
enddo; enddo; enddo
endif
end subroutine utilities_updateGamma
!--------------------------------------------------------------------------------------------------
!> @brief forward FFT of data in field_real to field_fourier
!> @details Does an unweighted filtered FFT transform from real to complex
@ -502,64 +510,63 @@ end subroutine utilities_FFTvectorBackward
!> @brief doing convolution gamma_hat * field_real, ensuring that average value = fieldAim
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierGammaConvolution(fieldAim)
use numerics, only: &
memory_efficient
use math, only: &
math_det33, &
math_invert
use mesh, only: &
grid3, &
grid, &
grid3Offset
implicit none
real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx
real(pReal) :: matA(6,6), matInvA(6,6)
integer(pInt) :: &
i, j, k, &
l, m, n, o
logical :: err
write(6,'(/,a)') ' ... doing gamma convolution ...............................................'
flush(6)
use numerics, only: &
memory_efficient
use math, only: &
math_det33, &
math_invert2
use mesh, only: &
grid3, &
grid, &
grid3Offset
implicit none
real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx
real(pReal), dimension(6,6) :: A, A_inv
integer :: &
i, j, k, &
l, m, n, o
logical :: err
write(6,'(/,a)') ' ... doing gamma convolution ...............................................'
flush(6)
!--------------------------------------------------------------------------------------------------
! do the actual spectral method calculation (mechanical equilibrium)
memoryEfficient: if(memory_efficient) then
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red
if (any([i,j,k+grid3Offset] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k)
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx)
matA(1:3,1:3) = real(temp33_complex); matA(4:6,4:6) = real(temp33_complex)
matA(1:3,4:6) = aimag(temp33_complex); matA(4:6,1:3) = -aimag(temp33_complex)
if (abs(math_det33(matA(1:3,1:3))) > 1e-16) then
call math_invert(6_pInt, matA, matInvA, err)
temp33_complex = cmplx(matInvA(1:3,1:3),matInvA(1:3,4:6),pReal)
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt) &
gamma_hat(l,m,n,o,1,1,1) = temp33_complex(l,n)*conjg(-xi1st(o,i,j,k))*xi1st(m,i,j,k)
else
gamma_hat(1:3,1:3,1:3,1:3,1,1,1) = cmplx(0.0_pReal,0.0_pReal,pReal)
endif
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,j,k))
tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex
endif
enddo; enddo; enddo
else memoryEfficient
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid1Red
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,j,k) * tensorField_fourier(1:3,1:3,i,j,k))
tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex
enddo; enddo; enddo
endif memoryEfficient
if (grid3Offset == 0_pInt) &
tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim/wgt,0.0_pReal,pReal)
memoryEfficient: if(memory_efficient) then
do k = 1, grid3; do j = 1, grid(2); do i = 1, grid1Red
if (any([i,j,k+grid3Offset] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
forall(l = 1:3, m = 1:3) &
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,j,k))*xi1st(m,i,j,k)
forall(l = 1:3, m = 1:3) &
temp33_complex(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal)*xiDyad_cmplx)
A(1:3,1:3) = real(temp33_complex); A(4:6,4:6) = real(temp33_complex)
A(1:3,4:6) = aimag(temp33_complex); A(4:6,1:3) = -aimag(temp33_complex)
if (abs(math_det33(A(1:3,1:3))) > 1e-16) then
call math_invert2(A_inv, err, A)
temp33_complex = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal)
forall(l=1:3, m=1:3, n=1:3, o=1:3) &
gamma_hat(l,m,n,o,1,1,1) = temp33_complex(l,n)*conjg(-xi1st(o,i,j,k))*xi1st(m,i,j,k)
else
gamma_hat(1:3,1:3,1:3,1:3,1,1,1) = cmplx(0.0_pReal,0.0_pReal,pReal)
endif
forall(l = 1:3, m = 1:3) &
temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,1,1,1)*tensorField_fourier(1:3,1:3,i,j,k))
tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex
endif
enddo; enddo; enddo
else memoryEfficient
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid1Red
forall(l = 1:3, m = 1:3) &
temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3,i,j,k) * tensorField_fourier(1:3,1:3,i,j,k))
tensorField_fourier(1:3,1:3,i,j,k) = temp33_Complex
enddo; enddo; enddo
endif memoryEfficient
if (grid3Offset == 0) tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim/wgt,0.0_pReal,pReal)
end subroutine utilities_fourierGammaConvolution
@ -720,11 +727,11 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
use IO, only: &
IO_error
use math, only: &
math_Plain3333to99, &
math_plain99to3333, &
math_3333to99, &
math_99to3333, &
math_rotate_forward3333, &
math_rotate_forward33, &
math_invert
math_invert2
implicit none
real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance
@ -748,7 +755,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
allocate (c_reduced(size_reduced,size_reduced), source =0.0_pReal)
allocate (s_reduced(size_reduced,size_reduced), source =0.0_pReal)
allocate (sTimesC(size_reduced,size_reduced), source =0.0_pReal)
temp99_Real = math_Plain3333to99(math_rotate_forward3333(C,rot_BC))
temp99_Real = math_3333to99(math_rotate_forward3333(C,rot_BC))
if(debugGeneral) then
write(6,'(/,a)') ' ... updating masked compliance ............................................'
@ -767,7 +774,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
c_reduced(k,j) = temp99_Real(n,m)
endif; enddo; endif; enddo
call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness
call math_invert2(s_reduced, errmatinv, c_reduced) ! invert reduced stiffness
if (any(IEEE_is_NaN(s_reduced))) errmatinv = .true.
if (errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance')
temp99_Real = 0.0_pReal ! fill up compliance with zeros
@ -808,7 +815,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
' Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal
flush(6)
endif
utilities_maskedCompliance = math_Plain99to3333(temp99_Real)
utilities_maskedCompliance = math_99to3333(temp99_Real)
end function utilities_maskedCompliance
@ -1141,7 +1148,7 @@ subroutine utilities_updateIPcoords(F)
call utilities_fourierTensorDivergence()
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red
if (any(cNeq(xi1st(1:3,i,j,k),cmplx(0.0_pReal,0.0_pReal)))) &
if (any(cNeq(xi1st(1:3,i,j,k),cmplx(0.0,0.0,pReal)))) &
vectorField_fourier(1:3,i,j,k) = vectorField_fourier(1:3,i,j,k)/ &
sum(conjg(-xi1st(1:3,i,j,k))*xi1st(1:3,i,j,k))
enddo; enddo; enddo

18
src/thermal_adiabatic.f90
View File

@ -49,7 +49,7 @@ subroutine thermal_adiabatic_init
homogenization_Noutput, &
THERMAL_ADIABATIC_label, &
THERMAL_adiabatic_ID, &
material_homog, &
material_homogenizationAt, &
mappingHomogenization, &
thermalState, &
thermalMapping, &
@ -57,7 +57,6 @@ subroutine thermal_adiabatic_init
temperature, &
temperatureRate
use config, only: &
material_partHomogenization, &
config_homogenization
implicit none
@ -81,7 +80,7 @@ subroutine thermal_adiabatic_init
initializeInstances: do section = 1_pInt, size(thermal_type)
if (thermal_type(section) /= THERMAL_adiabatic_ID) cycle
NofMyHomog=count(material_homog==section)
NofMyHomog=count(material_homogenizationAt==section)
instance = thermal_typeInstance(section)
outputs = config_homogenization(section)%getStrings('(output)',defaultVal=emptyStringArray)
do i=1_pInt, size(outputs)
@ -121,6 +120,7 @@ function thermal_adiabatic_updateState(subdt, ip, el)
err_thermal_tolAbs, &
err_thermal_tolRel
use material, only: &
material_homogenizationAt, &
mappingHomogenization, &
thermalState, &
temperature, &
@ -141,7 +141,7 @@ function thermal_adiabatic_updateState(subdt, ip, el)
real(pReal) :: &
T, Tdot, dTdot_dT
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
offset = mappingHomogenization(1,ip,el)
T = thermalState(homog)%subState0(1,offset)
@ -164,10 +164,9 @@ end function thermal_adiabatic_updateState
!> @brief returns heat generation rate
!--------------------------------------------------------------------------------------------------
subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
use math, only: &
math_6toSym33
use material, only: &
homogenization_Ngrains, &
material_homogenizationAt, &
mappingHomogenization, &
phaseAt, &
phasememberAt, &
@ -181,7 +180,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
use source_thermal_externalheat, only: &
source_thermal_externalheat_getRateAndItsTangent
use crystallite, only: &
crystallite_Tstar_v, &
crystallite_S, &
crystallite_Lp
implicit none
@ -202,7 +201,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
source, &
constituent
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
instance = thermal_typeInstance(homog)
Tdot = 0.0_pReal
@ -214,7 +213,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
select case(phase_source(source,phase))
case (SOURCE_thermal_dissipation_ID)
call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, &
math_6toSym33(crystallite_Tstar_v(1:6,grain,ip,el)), &
crystallite_S(1:3,1:3,grain,ip,el), &
crystallite_Lp(1:3,1:3,grain,ip,el), &
phase)
@ -279,7 +278,6 @@ function thermal_adiabatic_getMassDensity(ip,el)
lattice_massDensity
use material, only: &
homogenization_Ngrains, &
mappingHomogenization, &
material_phase
use mesh, only: &
mesh_element

20
src/thermal_conduction.f90
View File

@ -50,7 +50,7 @@ subroutine thermal_conduction_init
homogenization_Noutput, &
THERMAL_conduction_label, &
THERMAL_conduction_ID, &
material_homog, &
material_homogenizationAt, &
mappingHomogenization, &
thermalState, &
thermalMapping, &
@ -58,7 +58,6 @@ subroutine thermal_conduction_init
temperature, &
temperatureRate
use config, only: &
material_partHomogenization, &
config_homogenization
implicit none
@ -70,7 +69,7 @@ subroutine thermal_conduction_init
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>'
maxNinstance = int(count(thermal_type == THERMAL_conduction_ID),pInt)
maxNinstance = count(thermal_type == THERMAL_conduction_ID)
if (maxNinstance == 0_pInt) return
allocate(thermal_conduction_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
@ -82,7 +81,7 @@ subroutine thermal_conduction_init
initializeInstances: do section = 1_pInt, size(thermal_type)
if (thermal_type(section) /= THERMAL_conduction_ID) cycle
NofMyHomog=count(material_homog==section)
NofMyHomog=count(material_homogenizationAt==section)
instance = thermal_typeInstance(section)
outputs = config_homogenization(section)%getStrings('(output)',defaultVal=emptyStringArray)
do i=1_pInt, size(outputs)
@ -119,9 +118,8 @@ end subroutine thermal_conduction_init
!> @brief returns heat generation rate
!--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
use math, only: &
math_6toSym33
use material, only: &
material_homogenizationAt, &
homogenization_Ngrains, &
mappingHomogenization, &
phaseAt, &
@ -136,7 +134,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
use source_thermal_externalheat, only: &
source_thermal_externalheat_getRateAndItsTangent
use crystallite, only: &
crystallite_Tstar_v, &
crystallite_S, &
crystallite_Lp
implicit none
@ -158,7 +156,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
source, &
constituent
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
offset = mappingHomogenization(1,ip,el)
instance = thermal_typeInstance(homog)
@ -171,7 +169,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
select case(phase_source(source,phase))
case (SOURCE_thermal_dissipation_ID)
call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, &
math_6toSym33(crystallite_Tstar_v(1:6,grain,ip,el)), &
crystallite_S(1:3,1:3,grain,ip,el), &
crystallite_Lp(1:3,1:3,grain,ip,el), &
phase)
@ -305,7 +303,7 @@ end function thermal_conduction_getMassDensity
!--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el)
use material, only: &
mappingHomogenization, &
material_homogenizationAt, &
temperature, &
temperatureRate, &
thermalMapping
@ -321,7 +319,7 @@ subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el)
homog, &
offset
homog = mappingHomogenization(2,ip,el)
homog = material_homogenizationAt(el)
offset = thermalMapping(homog)%p(ip,el)
temperature (homog)%p(offset) = T
temperatureRate(homog)%p(offset) = Tdot

28
src/thermal_isothermal.f90
View File

@ -16,38 +16,28 @@ contains
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine thermal_isothermal_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
pReal
use config, only: &
material_Nhomogenization
use material
implicit none
integer(pInt) :: &
integer :: &
homog, &
NofMyHomog
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
initializeInstances: do homog = 1_pInt, material_Nhomogenization
initializeInstances: do homog = 1, material_Nhomogenization
if (thermal_type(homog) /= THERMAL_isothermal_ID) cycle
NofMyHomog = count(material_homog == homog)
thermalState(homog)%sizeState = 0_pInt
thermalState(homog)%sizePostResults = 0_pInt
allocate(thermalState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal)
allocate(thermalState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
allocate(thermalState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal)
NofMyHomog = count(material_homogenizationAt == homog)
thermalState(homog)%sizeState = 0
thermalState(homog)%sizePostResults = 0
allocate(thermalState(homog)%state0 (0,NofMyHomog), source=0.0_pReal)
allocate(thermalState(homog)%subState0(0,NofMyHomog), source=0.0_pReal)
allocate(thermalState(homog)%state (0,NofMyHomog), source=0.0_pReal)
deallocate(temperature (homog)%p)
allocate (temperature (homog)%p(1), source=thermal_initialT(homog))