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

Merge branch 'development' into test_PETSc_pointer

This commit is contained in:
Martin Diehl 2019-05-30 17:31:51 +02:00
parent 7d5f5afe01 43a50713b0
commit 305c72584f
71 changed files with 3256 additions and 4900 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitlab-ci.yml
View File

@ -506,7 +506,7 @@ Processing:
- rm abq_addUserOutput.py marc_addUserOutput.py
- $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py
- cd $DAMASKROOT/processing/post
- rm marc_to_vtk.py vtk2ang.py DAD*.py
- rm vtk2ang.py DAD*.py
- $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py
except:
- master

2
PRIVATE

@ -1 +1 @@
Subproject commit aadf2d82a7e04646e3f20c3d526f27a6f90acef0
Subproject commit 3a2f89547c264044a7bfab9d33aee78eec495a76

2
VERSION
View File

@ -1 +1 @@
v2.0.3-252-g0e77be25
v2.0.3-344-gb25c64d1

2
cmake/Compiler-Intel.cmake
View File

@ -32,6 +32,8 @@
# disables warnings ...
set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268")
# ... the text exceeds right hand column allowed on the line (we have only comments there)
set (COMPILE_FLAGS "${COMPILE_FLAGS},7624")
# ... about deprecated forall (has nice syntax and most likely a performance advantage)
set (COMPILE_FLAGS "${COMPILE_FLAGS} -warn")
# enables warnings ...

35
processing/post/DADF5_postResults.py
View File

@ -22,10 +22,15 @@ parser.add_argument('filenames', nargs='+',
help='DADF5 files')
parser.add_argument('-d','--dir', dest='dir',default='postProc',metavar='string',
help='name of subdirectory to hold output')
parser.add_argument('--mat', nargs='+',
help='labels for materialpoint/homogenization',dest='mat')
parser.add_argument('--con', nargs='+',
help='labels for constituent/crystallite/constitutive',dest='con')
options = parser.parse_args()
options.labels = ['Fe','Fp','xi_sl']
if options.mat is None: options.mat=[]
if options.con is None: options.con=[]
# --- loop over input files ------------------------------------------------------------------------
@ -49,15 +54,12 @@ for filename in options.filenames:
data = np.array([inc['inc'] for j in range(np.product(results.grid))]).reshape([np.product(results.grid),1])
header+= 'inc'
data = np.concatenate((data,np.array([j+1 for j in range(np.product(results.grid))]).reshape([np.product(results.grid),1])),1)
header+=' node'
coords = coords.reshape([np.product(results.grid),3])
data = np.concatenate((data,coords),1)
header+=' 1_pos 2_pos 3_pos'
results.active['increments'] = [inc]
for label in options.labels:
for label in options.con:
for o in results.c_output_types:
results.active['c_output_types'] = [o]
for c in results.constituents:
@ -67,12 +69,33 @@ for filename in options.filenames:
continue
label = x[0].split('/')[-1]
array = results.read_dataset(x,0)
d = np.product(np.shape(array)[1:])
d = int(np.product(np.shape(array)[1:]))
array = np.reshape(array,[np.product(results.grid),d])
data = np.concatenate((data,array),1)
if d>1:
header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)])
else:
header+=' '+label
for label in options.mat:
for o in results.m_output_types:
results.active['m_output_types'] = [o]
for m in results.materialpoints:
results.active['materialpoints'] = [m]
x = results.get_dataset_location(label)
if len(x) == 0:
continue
label = x[0].split('/')[-1]
array = results.read_dataset(x,0)
d = int(np.product(np.shape(array)[1:]))
array = np.reshape(array,[np.product(results.grid),d])
data = np.concatenate((data,array),1)
if d>1:
header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)])
else:
header+=' '+label
dirname = os.path.abspath(os.path.join(os.path.dirname(filename),options.dir))
try:

11
processing/post/DADF5_vtk_cells.py
View File

@ -23,10 +23,15 @@ parser.add_argument('filenames', nargs='+',
help='DADF5 files')
parser.add_argument('-d','--dir', dest='dir',default='postProc',metavar='string',
help='name of subdirectory to hold output')
parser.add_argument('--mat', nargs='+',
help='labels for materialpoint/homogenization',dest='mat')
parser.add_argument('--con', nargs='+',
help='labels for constituent/crystallite/constitutive',dest='con')
options = parser.parse_args()
options.labels = ['Fe','Fp','xi_sl']
if options.mat is None: options.mat=[]
if options.con is None: options.con=[]
# --- loop over input files ------------------------------------------------------------------------
@ -54,7 +59,9 @@ for filename in options.filenames:
print('Output step {}/{}'.format(i+1,len(results.increments)))
vtk_data = []
results.active['increments'] = [inc]
for label in options.labels:
for label in options.con:
for o in results.c_output_types:
results.active['c_output_types'] = [o]
if o != 'generic':

199
processing/post/marc_to_vtk.py
View File

@ -1,199 +0,0 @@
#!/usr/bin/env python2.7
# -*- coding: UTF-8 no BOM -*-
import os,sys,re
import argparse
import damask
import vtk, numpy as np
scriptName = os.path.splitext(os.path.basename(__file__))[0]
scriptID = ' '.join([scriptName, damask.version])
parser = argparse.ArgumentParser(description='Convert from Marc input file format (.dat) to VTK format (.vtu)', version = scriptID)
parser.add_argument('filename', type=str, help='file to convert')
parser.add_argument('-t', '--table', type=str, help='ASCIItable file containing nodal data to subdivide and interpolate')
args = parser.parse_args()
with open(args.filename, 'r') as marcfile:
marctext = marcfile.read();
# Load table (if any)
if args.table is not None:
try:
table = damask.ASCIItable(
name=args.table,
outname='subdivided_{}'.format(args.table),
buffered=True
)
table.head_read()
table.data_readArray()
# Python list is faster for appending
nodal_data = list(table.data)
except: args.table = None
# Extract connectivity chunk from file...
connectivity_text = re.findall(r'connectivity[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0]
connectivity_lines = re.split(r'[\n\r]+', connectivity_text, flags=(re.MULTILINE | re.DOTALL))
connectivity_header = connectivity_lines[0]
connectivity_lines = connectivity_lines[1:]
# Construct element map
elements = dict(map(lambda line:
(
int(line[0:10]), # index
{
'type': int(line[10:20]),
'verts': list(map(int, re.split(r' +', line[20:].strip())))
}
), connectivity_lines))
# Extract coordinate chunk from file
coordinates_text = re.findall(r'coordinates[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0]
coordinates_lines = re.split(r'[\n\r]+', coordinates_text, flags=(re.MULTILINE | re.DOTALL))
coordinates_header = coordinates_lines[0]
coordinates_lines = coordinates_lines[1:]
# marc input file does not use "e" in scientific notation, this adds it and converts
fl_format = lambda string: float(re.sub(r'(\d)([\+\-])', r'\1e\2', string))
# Construct coordinate map
coordinates = dict(map(lambda line:
(
int(line[0:10]),
np.array([
fl_format(line[10:30]),
fl_format(line[30:50]),
fl_format(line[50:70])
])
), coordinates_lines))
# Subdivide volumes
grid = vtk.vtkUnstructuredGrid()
vertex_count = len(coordinates)
edge_to_vert = dict() # when edges are subdivided, a new vertex in the middle is produced and placed in here
ordered_pair = lambda a, b: (a, b) if a < b else (b, a) # edges are bidirectional
def subdivide_edge(vert1, vert2):
edge = ordered_pair(vert1, vert2)
if edge in edge_to_vert:
return edge_to_vert[edge]
# Vertex does not exist, create it
newvert = len(coordinates) + 1
coordinates[newvert] = 0.5 * (coordinates[vert1] + coordinates[vert2]) # Average
edge_to_vert[edge] = newvert;
# Interpolate nodal data
if args.table is not None:
nodal_data.append(0.5 * (nodal_data[vert1 - 1] + nodal_data[vert2 - 1]))
return newvert;
for el_id in range(1, len(elements) + 1): # Marc starts counting at 1
el = elements[el_id]
if el['type'] == 7:
# Hexahedron, subdivided
# There may be a better way to iterate over these, but this is consistent
# with the ordering scheme provided at https://damask.mpie.de/pub/Documentation/ElementType
subverts = np.zeros((3,3,3), dtype=int)
# Get corners
subverts[0, 0, 0] = el['verts'][0]
subverts[2, 0, 0] = el['verts'][1]
subverts[2, 2, 0] = el['verts'][2]
subverts[0, 2, 0] = el['verts'][3]
subverts[0, 0, 2] = el['verts'][4]
subverts[2, 0, 2] = el['verts'][5]
subverts[2, 2, 2] = el['verts'][6]
subverts[0, 2, 2] = el['verts'][7]
# lower edges
subverts[1, 0, 0] = subdivide_edge(subverts[0, 0, 0], subverts[2, 0, 0])
subverts[2, 1, 0] = subdivide_edge(subverts[2, 0, 0], subverts[2, 2, 0])
subverts[1, 2, 0] = subdivide_edge(subverts[2, 2, 0], subverts[0, 2, 0])
subverts[0, 1, 0] = subdivide_edge(subverts[0, 2, 0], subverts[0, 0, 0])
# middle edges
subverts[0, 0, 1] = subdivide_edge(subverts[0, 0, 0], subverts[0, 0, 2])
subverts[2, 0, 1] = subdivide_edge(subverts[2, 0, 0], subverts[2, 0, 2])
subverts[2, 2, 1] = subdivide_edge(subverts[2, 2, 0], subverts[2, 2, 2])
subverts[0, 2, 1] = subdivide_edge(subverts[0, 2, 0], subverts[0, 2, 2])
# top edges
subverts[1, 0, 2] = subdivide_edge(subverts[0, 0, 2], subverts[2, 0, 2])
subverts[2, 1, 2] = subdivide_edge(subverts[2, 0, 2], subverts[2, 2, 2])
subverts[1, 2, 2] = subdivide_edge(subverts[2, 2, 2], subverts[0, 2, 2])
subverts[0, 1, 2] = subdivide_edge(subverts[0, 2, 2], subverts[0, 0, 2])
# then faces... The edge_to_vert addition is due to there being two ways
# to calculate a face vertex, depending on which opposite vertices are used to subdivide.
# This way, we avoid creating duplicate vertices.
subverts[1, 1, 0] = subdivide_edge(subverts[1, 0, 0], subverts[1, 2, 0])
edge_to_vert[ordered_pair(subverts[0, 1, 0], subverts[2, 1, 0])] = subverts[1, 1, 0]
subverts[1, 0, 1] = subdivide_edge(subverts[1, 0, 0], subverts[1, 0, 2])
edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[2, 0, 1])] = subverts[1, 0, 1]
subverts[2, 1, 1] = subdivide_edge(subverts[2, 1, 0], subverts[2, 1, 2])
edge_to_vert[ordered_pair(subverts[2, 0, 1], subverts[2, 2, 1])] = subverts[2, 1, 1]
subverts[1, 2, 1] = subdivide_edge(subverts[1, 2, 0], subverts[1, 2, 2])
edge_to_vert[ordered_pair(subverts[0, 2, 1], subverts[2, 2, 1])] = subverts[1, 2, 1]
subverts[0, 1, 1] = subdivide_edge(subverts[0, 1, 0], subverts[0, 1, 2])
edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[0, 2, 1])] = subverts[0, 1, 1]
subverts[1, 1, 2] = subdivide_edge(subverts[1, 0, 2], subverts[1, 2, 2])
edge_to_vert[ordered_pair(subverts[0, 1, 2], subverts[2, 1, 2])] = subverts[1, 1, 2]
# and finally the center. There are three ways to calculate, but elements should
# not intersect, so the edge_to_vert part isn't needed here.
subverts[1, 1, 1] = subdivide_edge(subverts[1, 1, 0], subverts[1, 1, 2])
# Now make the hexahedron subelements
# order in which vtk expects vertices for a hexahedron
order = np.array([(0,0,0),(1,0,0),(1,1,0),(0,1,0),(0,0,1),(1,0,1),(1,1,1),(0,1,1)])
for z in range(2):
for y in range(2):
for x in range(2):
hex_ = vtk.vtkHexahedron()
for vert_id in range(8):
coord = order[vert_id] + (x, y, z)
# minus one, since vtk starts at zero but marc starts at one
hex_.GetPointIds().SetId(vert_id, subverts[coord[0], coord[1], coord[2]] - 1)
grid.InsertNextCell(hex_.GetCellType(), hex_.GetPointIds())
else:
damask.util.croak('Unsupported Marc element type: {} (skipping)'.format(el['type']))
# Load all points
points = vtk.vtkPoints()
for point in range(1, len(coordinates) + 1): # marc indices start at 1
points.InsertNextPoint(coordinates[point].tolist())
grid.SetPoints(points)
# grid now contains the elements from the given marc file
writer = vtk.vtkXMLUnstructuredGridWriter()
writer.SetFileName(re.sub(r'\..+', ".vtu", args.filename)) # *.vtk extension does not work in paraview
if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(grid)
else: writer.SetInputData(grid)
writer.Write()
if args.table is not None:
table.info_append([
scriptID + ' ' + ' '.join(sys.argv[1:]),
])
table.head_write()
table.output_flush()
table.data = np.array(nodal_data)
table.data_writeArray()
table.close()

43
processing/pre/geom_addPrimitive.py
View File

@ -43,7 +43,7 @@ parser.add_option('-e', '--exponent', dest='exponent',
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',
type='float', metavar = 'float',
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),
@ -60,15 +60,24 @@ parser.add_option( '--nonperiodic', dest='periodic',
parser.add_option( '--realspace', dest='realspace',
action='store_true',
help = '-c and -d span [origin,origin+size] instead of [0,grid] coordinates')
parser.add_option( '--invert', dest='inside',
action='store_false',
help = 'invert the volume filled by the primitive (inside/outside)')
parser.add_option('--float', dest = 'float',
action = 'store_true',
help = 'use float input')
parser.set_defaults(center = (.0,.0,.0),
fill = 0,
fill = 0.0,
degrees = False,
exponent = (20,20,20), # box shape by default
periodic = True,
realspace = False,
inside = True,
float = False,
)
(options, filenames) = parser.parse_args()
if options.dimension is None:
parser.error('no dimension specified.')
if options.angleaxis is not None:
@ -78,6 +87,8 @@ elif options.quaternion is not None:
else:
rotation = damask.Rotation()
datatype = 'f' if options.float else 'i'
options.center = np.array(options.center)
options.dimension = np.array(options.dimension)
# undo logarithmic sense of exponent and generate ellipsoids for negative dimensions (backward compatibility)
@ -97,13 +108,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -115,7 +120,7 @@ for name in filenames:
#--- read data ------------------------------------------------------------------------------------
microstructure = table.microstructure_read(info['grid']) # read microstructure
microstructure = table.microstructure_read(info['grid'],datatype) # read microstructure
# --- do work ------------------------------------------------------------------------------------
@ -123,7 +128,7 @@ for name in filenames:
'microstructures': 0,
}
options.fill = microstructure.max()+1 if options.fill == 0 else options.fill
options.fill = np.nanmax(microstructure)+1 if options.fill == 0 else options.fill
microstructure = microstructure.reshape(info['grid'],order='F')
@ -193,19 +198,23 @@ for name in filenames:
grid[1] * j : grid[1] * (j+1),
grid[2] * k : grid[2] * (k+1)])**options.exponent[2] <= 1.0)
microstructure = np.where(inside, options.fill, microstructure)
microstructure = np.where(inside,
options.fill if options.inside else microstructure,
microstructure if options.inside else options.fill)
else: # nonperiodic, much lighter on resources
microstructure = np.where(np.abs(X)**options.exponent[0] +
np.abs(Y)**options.exponent[1] +
np.abs(Z)**options.exponent[2] <= 1.0, options.fill, microstructure)
np.abs(Z)**options.exponent[2] <= 1.0,
options.fill if options.inside else microstructure,
microstructure if options.inside else options.fill)
np.seterr(**old_settings) # Reset warnings to old state
newInfo['microstructures'] = microstructure.max()
newInfo['microstructures'] = len(np.unique(microstructure))
# --- report ---------------------------------------------------------------------------------------
if (newInfo['microstructures'] != info['microstructures']):
damask.util.croak('--> microstructures: %i'%newInfo['microstructures'])
damask.util.croak('--> microstructures: {}'.format(newInfo['microstructures']))
#--- write header ---------------------------------------------------------------------------------
@ -225,9 +234,9 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
formatwidth = int(math.floor(math.log10(microstructure.max())+1))
format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1)))
table.data = microstructure.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
table.data_writeArray(format,delimiter = ' ')
#--- output finalization --------------------------------------------------------------------------

14
processing/pre/geom_canvas.py
View File

@ -35,7 +35,7 @@ parser.add_option('-f',
type = 'float', metavar = 'float',
help = '(background) canvas grain index. "0" selects maximum microstructure index + 1 [%default]')
parser.add_option('--float',
dest = 'real',
dest = 'float',
action = 'store_true',
help = 'use float input')
parser.add_option('--blank',
@ -45,13 +45,13 @@ parser.add_option('--blank',
parser.set_defaults(grid = ['0','0','0'],
offset = (0,0,0),
fill = 0,
real = False,
fill = 0.0,
float = False,
)
(options, filenames) = parser.parse_args()
datatype = 'f' if options.real else 'i'
datatype = 'f' if options.float else 'i'
options.grid = ['1','1','1'] if options.blank and options.grid == ['0','0','0'] else options.grid
options.fill = 1 if options.blank and options.fill == 0 else options.fill
@ -107,7 +107,7 @@ for name in filenames:
newInfo['grid'] = np.where(newInfo['grid'] > 0, newInfo['grid'],info['grid'])
microstructure_cropped = np.zeros(newInfo['grid'],datatype)
microstructure_cropped.fill(options.fill if options.real or options.fill > 0 else microstructure.max()+1)
microstructure_cropped.fill(options.fill if options.float or options.fill > 0 else np.nanmax(microstructure)+1)
if not options.blank:
xindex = np.arange(max(options.offset[0],0),min(options.offset[0]+newInfo['grid'][0],info['grid'][0]))
@ -130,7 +130,7 @@ for name in filenames:
newInfo['size'] = info['size']/info['grid']*newInfo['grid'] if np.all(info['grid'] > 0) else newInfo['grid']
newInfo['origin'] = info['origin']+(info['size']/info['grid'] if np.all(info['grid'] > 0) \
else newInfo['size']/newInfo['grid'])*options.offset
newInfo['microstructures'] = microstructure_cropped.max()
newInfo['microstructures'] = len(np.unique(microstructure_cropped))
# --- report ---------------------------------------------------------------------------------------
@ -172,7 +172,7 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
format = '%g' if options.real else '%{}i'.format(int(math.floor(math.log10(microstructure_cropped.max())+1)))
format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure_cropped))+1)))
table.data = microstructure_cropped.reshape((newInfo['grid'][0],newInfo['grid'][1]*newInfo['grid'][2]),order='F').transpose()
table.data_writeArray(format,delimiter=' ')

14
processing/pre/geom_clean.py
View File

@ -50,13 +50,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))),
'size x y z: {}'.format(' x '.join(map(str,info['size']))),
'origin x y z: {}'.format(' : '.join(map(str,info['origin']))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -73,7 +67,7 @@ for name in filenames:
# --- do work ------------------------------------------------------------------------------------
microstructure = ndimage.filters.generic_filter(microstructure,mostFrequent,size=(options.stencil,)*3).astype('int_')
newInfo = {'microstructures': microstructure.max()}
newInfo = {'microstructures': len(np.unique(microstructure))}
# --- report ---------------------------------------------------------------------------------------
if ( newInfo['microstructures'] != info['microstructures']):
@ -91,9 +85,9 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
formatwidth = int(math.floor(math.log10(microstructure.max())+1))
formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
table.data = microstructure.reshape((info['grid'][0],np.prod(info['grid'][1:])),order='F').transpose()
table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ')
# --- output finalization --------------------------------------------------------------------------

7
processing/pre/geom_fromMinimalSurface.py
View File

@ -90,12 +90,7 @@ for name in filenames:
#--- report ---------------------------------------------------------------------------------------
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')

9
processing/pre/geom_fromTable.py
View File

@ -192,12 +192,7 @@ for name in filenames:
'homogenization': options.homogenization,
}
damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))),
'size x y z: {}'.format(' x '.join(map(str,info['size']))),
'origin x y z: {}'.format(' : '.join(map(str,info['origin']))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
damask.util.report_geom(info)
# --- write header ---------------------------------------------------------------------------------
@ -230,7 +225,7 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
table.data = grain.reshape(info['grid'][1]*info['grid'][2],info['grid'][0])
table.data_writeArray('%%%ii'%(formatwidth),delimiter=' ')
table.data_writeArray('%{}i'.format(formatwidth),delimiter=' ')
#--- output finalization --------------------------------------------------------------------------

13
processing/pre/geom_grainGrowth.py
View File

@ -69,13 +69,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))),
'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))),
'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -200,8 +194,7 @@ for name in filenames:
newID += 1
microstructure = np.where(microstructure == microstructureID, newID, microstructure)
newInfo = {'microstructures': 0,}
newInfo['microstructures'] = microstructure.max()
newInfo = {'microstructures': len(np.unique(microstructure)),}
# --- report --------------------------------------------------------------------------------------
@ -226,7 +219,7 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
formatwidth = int(math.floor(math.log10(microstructure.max())+1))
formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
table.data = microstructure[::1 if info['grid'][0]>1 else 2,
::1 if info['grid'][1]>1 else 2,
::1 if info['grid'][2]>1 else 2,].\

26
processing/pre/geom_mirror.py
View File

@ -23,6 +23,13 @@ parser.add_option('-d','--direction',
dest = 'directions',
action = 'extend', metavar = '<string LIST>',
help = "directions in which to mirror {'x','y','z'}")
parser.add_option('--float',
dest = 'float',
action = 'store_true',
help = 'use float input')
parser.set_defaults(float = False,
)
(options, filenames) = parser.parse_args()
@ -32,6 +39,8 @@ if not set(options.directions).issubset(validDirections):
invalidDirections = [str(e) for e in set(options.directions).difference(validDirections)]
parser.error('invalid directions {}. '.format(*invalidDirections))
datatype = 'f' if options.float else 'i'
# --- loop over input files -------------------------------------------------------------------------
if filenames == []: filenames = [None]
@ -39,7 +48,8 @@ if filenames == []: filenames = [None]
for name in filenames:
try:
table = damask.ASCIItable(name = name,
buffered = False, labeled = False)
buffered = False,
labeled = False)
except: continue
damask.util.report(scriptName,name)
@ -47,13 +57,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -65,7 +69,7 @@ for name in filenames:
# --- read data ------------------------------------------------------------------------------------
microstructure = table.microstructure_read(info['grid']).reshape(info['grid'],order='F') # read microstructure
microstructure = table.microstructure_read(info['grid'],datatype).reshape(info['grid'],order='F') # read microstructure
if 'z' in options.directions:
microstructure = np.concatenate([microstructure,microstructure[:,:,::-1]],2)
@ -107,9 +111,9 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
formatwidth = int(math.floor(math.log10(microstructure.max())+1))
formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
table.data = microstructure.reshape((newInfo['grid'][0],np.prod(newInfo['grid'][1:])),order='F').transpose()
table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ')
# --- output finalization --------------------------------------------------------------------------

8
processing/pre/geom_pack.py
View File

@ -35,13 +35,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))),
'size x y z: {}'.format(' x '.join(map(str,info['size']))),
'origin x y z: {}'.format(' : '.join(map(str,info['origin']))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')

10
processing/pre/geom_renumber.py
View File

@ -35,13 +35,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -93,7 +87,7 @@ for name in filenames:
# --- write microstructure information -----------------------------------------------------------
format = '%{}i'.format(int(math.floor(math.log10(newInfo['microstructures'])+1)))
format = '%{}i'.format(int(math.floor(math.log10(np.nanmax(renumbered))+1)))
table.data = renumbered.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
table.data_writeArray(format,delimiter = ' ')

26
processing/pre/geom_rescale.py
View File

@ -31,14 +31,21 @@ parser.add_option('-r', '--renumber',
dest = 'renumber',
action = 'store_true',
help = 'renumber microstructure indices from 1..N [%default]')
parser.add_option('--float',
dest = 'float',
action = 'store_true',
help = 'use float input')
parser.set_defaults(renumber = False,
grid = ['0','0','0'],
size = ['0.0','0.0','0.0'],
float = False,
)
(options, filenames) = parser.parse_args()
datatype = 'f' if options.float else 'i'
# --- loop over input files -------------------------------------------------------------------------
if filenames == []: filenames = [None]
@ -46,7 +53,8 @@ if filenames == []: filenames = [None]
for name in filenames:
try:
table = damask.ASCIItable(name = name,
buffered = False, labeled = False)
buffered = False,
labeled = False)
except: continue
damask.util.report(scriptName,name)
@ -54,13 +62,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -72,7 +74,7 @@ for name in filenames:
# --- read data ------------------------------------------------------------------------------------
microstructure = table.microstructure_read(info['grid']) # read microstructure
microstructure = table.microstructure_read(info['grid'],datatype) # read microstructure
# --- do work ------------------------------------------------------------------------------------
@ -113,7 +115,7 @@ for name in filenames:
newID += 1
microstructure = np.where(microstructure == microstructureID, newID,microstructure).reshape(microstructure.shape)
newInfo['microstructures'] = microstructure.max()
newInfo['microstructures'] = len(np.unique(microstructure))
# --- report ---------------------------------------------------------------------------------------
@ -152,9 +154,9 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
formatwidth = int(math.floor(math.log10(microstructure.max())+1))
format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1)))
table.data = microstructure.reshape((newInfo['grid'][0],newInfo['grid'][1]*newInfo['grid'][2]),order='F').transpose()
table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
table.data_writeArray(format,delimiter=' ')
# --- output finalization --------------------------------------------------------------------------

35
processing/pre/geom_rotate.py
View File

@ -43,9 +43,15 @@ parser.add_option('-f', '--fill',
dest = 'fill',
type = 'int', metavar = 'int',
help = 'background grain index. "0" selects maximum microstructure index + 1 [%default]')
parser.add_option('--float',
dest = 'float',
action = 'store_true',
help = 'use float input')
parser.set_defaults(degrees = False,
fill = 0)
fill = 0,
float = False,
)
(options, filenames) = parser.parse_args()
@ -61,6 +67,8 @@ if options.matrix is not None:
if options.eulers is not None:
eulers = damask.Rotation.fromEulers(np.array(options.eulers),degrees=True).asEulers(degrees=True)
datatype = 'f' if options.float else 'i'
# --- loop over input files -------------------------------------------------------------------------
if filenames == []: filenames = [None]
@ -77,13 +85,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))),
'size x y z: {}'.format(' x '.join(map(str,info['size']))),
'origin x y z: {}'.format(' : '.join(map(str,info['origin']))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -95,9 +97,9 @@ for name in filenames:
# --- read data ------------------------------------------------------------------------------------
microstructure = table.microstructure_read(info['grid']).reshape(info['grid'],order='F') # read microstructure
microstructure = table.microstructure_read(info['grid'],datatype).reshape(info['grid'],order='F') # read microstructure
newGrainID = options.fill if options.fill != 0 else microstructure.max()+1
newGrainID = options.fill if options.fill != 0 else np.nanmax(microstructure)+1
microstructure = ndimage.rotate(microstructure,eulers[2],(0,1),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around Z
microstructure = ndimage.rotate(microstructure,eulers[1],(1,2),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around X
microstructure = ndimage.rotate(microstructure,eulers[0],(0,1),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around Z
@ -107,19 +109,18 @@ for name in filenames:
newInfo = {
'size': microstructure.shape*info['size']/info['grid'],
'grid': microstructure.shape,
'microstructures': microstructure.max(),
'microstructures': len(np.unique(microstructure)),
}
# --- report ---------------------------------------------------------------------------------------
remarks = []
if (any(newInfo['grid'] != info['grid'])):
remarks.append('--> grid a b c: %s'%(' x '.join(map(str,newInfo['grid']))))
remarks.append('--> grid a b c: {}'.format(' x '.join(map(str,newInfo['grid']))))
if (any(newInfo['size'] != info['size'])):
remarks.append('--> size x y z: %s'%(' x '.join(map(str,newInfo['size']))))
remarks.append('--> size x y z: {}'.format(' x '.join(map(str,newInfo['size']))))
if ( newInfo['microstructures'] != info['microstructures']):
remarks.append('--> microstructures: %i'%newInfo['microstructures'])
remarks.append('--> microstructures: {}'.format(newInfo['microstructures']))
if remarks != []: damask.util.croak(remarks)
# --- write header ---------------------------------------------------------------------------------
@ -138,9 +139,9 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
formatwidth = int(math.floor(math.log10(microstructure.max())+1))
format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1)))
table.data = microstructure.reshape((newInfo['grid'][0],np.prod(newInfo['grid'][1:])),order='F').transpose()
table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
table.data_writeArray(format,delimiter=' ')
# --- output finalization --------------------------------------------------------------------------

14
processing/pre/geom_toTable.py
View File

@ -20,15 +20,15 @@ Translate geom description into ASCIItable containing position and microstructur
""", version = scriptID)
parser.add_option('--float',
dest = 'real',
dest = 'float',
action = 'store_true',
help = 'use float input')
parser.set_defaults(real = False,
parser.set_defaults(float = False,
)
(options, filenames) = parser.parse_args()
datatype = 'f' if options.real else 'i'
datatype = 'f' if options.float else 'i'
# --- loop over input files -------------------------------------------------------------------------
@ -47,13 +47,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))),
'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))),
'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')

20
processing/pre/geom_translate.py
View File

@ -31,19 +31,19 @@ parser.add_option('-s', '--substitute',
action = 'extend', metavar = '<string LIST>',
help = 'substitutions of microstructure indices from,to,from,to,...')
parser.add_option('--float',
dest = 'real',
dest = 'float',
action = 'store_true',
help = 'use float input')
parser.set_defaults(origin = (0.0,0.0,0.0),
microstructure = 0,
substitute = [],
real = False,
float = False,
)
(options, filenames) = parser.parse_args()
datatype = 'f' if options.real else 'i'
datatype = 'f' if options.float else 'i'
sub = {}
for i in range(len(options.substitute)//2): # split substitution list into "from" -> "to"
@ -64,13 +64,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -103,9 +97,9 @@ for name in filenames:
remarks = []
if (any(newInfo['origin'] != info['origin'])):
remarks.append('--> origin x y z: %s'%(' : '.join(map(str,newInfo['origin']))))
remarks.append('--> origin x y z: {}'.format(' : '.join(map(str,newInfo['origin']))))
if ( newInfo['microstructures'] != info['microstructures']):
remarks.append('--> microstructures: %i'%newInfo['microstructures'])
remarks.append('--> microstructures: {}'.format(newInfo['microstructures']))
if remarks != []: damask.util.croak(remarks)
# --- write header -------------------------------------------------------------------------------
@ -124,7 +118,7 @@ for name in filenames:
# --- write microstructure information -----------------------------------------------------------
format = '%g' if options.real else '%{}i'.format(int(math.floor(math.log10(microstructure.max())+1)))
format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(substituted))+1)))
table.data = substituted.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
table.data_writeArray(format,delimiter = ' ')

8
processing/pre/geom_unpack.py
View File

@ -43,13 +43,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')

14
processing/pre/geom_vicinityOffset.py
View File

@ -73,13 +73,7 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
])
damask.util.report_geom(info)
errors = []
if np.any(info['grid'] < 1): errors.append('invalid grid a b c.')
@ -108,7 +102,7 @@ for name in filenames:
extra_keywords={"trigger":options.trigger,"size":1+2*options.vicinity}),
microstructure + options.offset,microstructure)
newInfo['microstructures'] = microstructure.max()
newInfo['microstructures'] = len(np.unique(microstructure))
# --- report ---------------------------------------------------------------------------------------
@ -131,9 +125,9 @@ for name in filenames:
# --- write microstructure information ------------------------------------------------------------
formatwidth = int(math.floor(math.log10(microstructure.max())+1))
formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
table.data = microstructure.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ')
# --- output finalization --------------------------------------------------------------------------

53
python/damask/dadf5.py
View File

@ -49,15 +49,23 @@ class DADF5():
self.c_output_types.append(o)
self.c_output_types = list(set(self.c_output_types)) # make unique
self.m_output_types = []
for m in self.materialpoints:
for o in f['inc{:05}/materialpoint/{}'.format(self.increments[0]['inc'],m)].keys():
self.m_output_types.append(o)
self.m_output_types = list(set(self.m_output_types)) # make unique
self.active= {'increments': self.increments,
'constituents': self.constituents,
'materialpoints': self.materialpoints,
'constituent': self.Nconstituents,
'c_output_types': self.c_output_types}
'c_output_types': self.c_output_types,
'm_output_types': self.m_output_types}
self.filename = filename
self.mode = mode
def list_data(self):
"""Shows information on all datasets in the file"""
with h5py.File(self.filename,'r') as f:
@ -73,6 +81,16 @@ class DADF5():
print(' {} ({})'.format(x,f[group_output_types+'/'+x].attrs['Description'].decode()))
except:
pass
for m in self.active['materialpoints']:
group_materialpoint = group_inc+'/materialpoint/'+m
for t in self.active['m_output_types']:
print(' {}'.format(t))
group_output_types = group_materialpoint+'/'+t
try:
for x in f[group_output_types].keys():
print(' {} ({})'.format(x,f[group_output_types+'/'+x].attrs['Description'].decode()))
except:
pass
def get_dataset_location(self,label):
@ -81,14 +99,25 @@ class DADF5():
with h5py.File(self.filename,'r') as f:
for i in self.active['increments']:
group_inc = 'inc{:05}'.format(i['inc'])
for c in self.active['constituents']:
group_constituent = group_inc+'/constituent/'+c
for t in self.active['c_output_types']:
try:
f[group_constituent+'/'+t+'/'+label]
path.append(group_constituent+'/'+t+'/'+label)
except:
pass
except Exception as e:
print('unable to locate constituents dataset: '+ str(e))
for m in self.active['materialpoints']:
group_materialpoint = group_inc+'/materialpoint/'+m
for t in self.active['m_output_types']:
try:
f[group_materialpoint+'/'+t+'/'+label]
path.append(group_materialpoint+'/'+t+'/'+label)
except Exception as e:
print('unable to locate materialpoints dataset: '+ str(e))
return path
@ -100,12 +129,28 @@ class DADF5():
"""
with h5py.File(self.filename,'r') as f:
shape = (self.Nmaterialpoints,) + np.shape(f[path[0]])[1:]
if len(shape) == 1: shape = shape +(1,)
dataset = np.full(shape,np.nan)
for pa in path:
label = pa.split('/')[2]
try:
p = np.where(f['mapping/cellResults/constituent'][:,c]['Name'] == str.encode(label))[0]
u = (f['mapping/cellResults/constituent'][p,c]['Position'])
dataset[p,:] = f[pa][u,:]
a = np.array(f[pa])
if len(a.shape) == 1:
a=a.reshape([a.shape[0],1])
dataset[p,:] = a[u,:]
except Exception as e:
print('unable to read constituent: '+ str(e))
try:
p = np.where(f['mapping/cellResults/materialpoint']['Name'] == str.encode(label))[0]
u = (f['mapping/cellResults/materialpoint'][p.tolist()]['Position'])
a = np.array(f[pa])
if len(a.shape) == 1:
a=a.reshape([a.shape[0],1])
dataset[p,:] = a[u,:]
except Exception as e:
print('unable to read materialpoint: '+ str(e))
return dataset

22
python/damask/orientation.py
View File

@ -227,12 +227,17 @@ class Rotation:
return cls(ax2qu(ax))
@classmethod
def fromMatrix(cls,
matrix,
containsStretch = False): #ToDo: better name?
def fromBasis(cls,
basis,
orthonormal = True,
reciprocal = False,
):
om = matrix if isinstance(matrix, np.ndarray) else np.array(matrix).reshape((3,3)) # ToDo: Reshape here or require explicit?
if containsStretch:
om = basis if isinstance(basis, np.ndarray) else np.array(basis).reshape((3,3))
if reciprocal:
om = np.linalg.inv(om.T/np.pi) # transform reciprocal basis set
orthonormal = False # contains stretch
if not orthonormal:
(U,S,Vh) = np.linalg.svd(om) # singular value decomposition
om = np.dot(U,Vh)
if not np.isclose(np.linalg.det(om),1.0):
@ -244,6 +249,13 @@ class Rotation:
return cls(om2qu(om))
@classmethod
def fromMatrix(cls,
om,
):
return cls.fromBasis(om)
@classmethod
def fromRodrigues(cls,
rodrigues,

12
src/CPFEM.f90
View File

@ -4,9 +4,7 @@
!> @brief CPFEM engine
!--------------------------------------------------------------------------------------------------
module CPFEM
use prec, only: &
pReal, &
pInt
use prec
implicit none
private
@ -57,8 +55,6 @@ contains
!> @brief call (thread safe) all module initializations
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll(el,ip)
use prec, only: &
prec_init
use numerics, only: &
numerics_init
use debug, only: &
@ -91,7 +87,6 @@ subroutine CPFEM_initAll(el,ip)
IO_init
use DAMASK_interface
implicit none
integer(pInt), intent(in) :: el, & !< FE el number
ip !< FE integration point number
@ -155,7 +150,6 @@ subroutine CPFEM_init
crystallite_Li0, &
crystallite_S0
implicit none
integer :: k,l,m,ph,homog
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
@ -325,7 +319,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
IO_warning
use DAMASK_interface
implicit none
integer(pInt), intent(in) :: elFE, & !< FE element number
ip !< integration point number
real(pReal), intent(in) :: dt !< time increment
@ -639,8 +632,6 @@ end subroutine CPFEM_general
!> @brief triggers writing of the results
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_results(inc,time)
use prec, only: &
pInt
#ifdef DAMASK_HDF5
use results
use HDF5_utilities
@ -650,7 +641,6 @@ subroutine CPFEM_results(inc,time)
use crystallite, only: &
crystallite_results
implicit none
integer(pInt), intent(in) :: inc
real(pReal), intent(in) :: time

42
src/CPFEM2.f90
View File

@ -12,6 +12,7 @@ module CPFEM2
CPFEM_age, &
CPFEM_initAll, &
CPFEM_results
contains
@ -20,7 +21,6 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll()
use prec, only: &
pInt, &
prec_init
use numerics, only: &
numerics_init
@ -57,8 +57,6 @@ subroutine CPFEM_initAll()
FEM_Zoo_init
#endif
implicit none
call DAMASK_interface_init ! Spectral and FEM interface to commandline
call prec_init
call IO_init
@ -87,8 +85,6 @@ end subroutine CPFEM_initAll
!> @brief allocate the arrays defined in module CPFEM and initialize them
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_init
use prec, only: &
pInt, pReal
use IO, only: &
IO_error
use numerics, only: &
@ -124,8 +120,8 @@ subroutine CPFEM_init
use DAMASK_interface, only: &
getSolverJobName
implicit none
integer(pInt) :: ph,homog
integer :: ph,homog
character(len=1024) :: rankStr, PlasticItem, HomogItem
integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
@ -134,7 +130,7 @@ subroutine CPFEM_init
! *** 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
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0) then
write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from hdf5 file'
flush(6)
endif
@ -152,14 +148,14 @@ subroutine CPFEM_init
call HDF5_read(fileHandle,crystallite_S0, 'convergedS')
groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
do ph = 1_pInt,size(phase_plasticity)
do ph = 1,size(phase_plasticity)
write(PlasticItem,*) ph,'_'
call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
enddo
call HDF5_closeGroup(groupPlasticID)
groupHomogID = HDF5_openGroup(fileHandle,'HomogStates')
do homog = 1_pInt, material_Nhomogenization
do homog = 1, material_Nhomogenization
write(HomogItem,*) homog,'_'
call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog')
enddo
@ -178,8 +174,7 @@ end subroutine CPFEM_init
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_age()
use prec, only: &
pReal, &
pInt
pReal
use numerics, only: &
worldrank
use debug, only: &
@ -224,12 +219,11 @@ subroutine CPFEM_age()
use DAMASK_interface, only: &
getSolverJobName
implicit none
integer(pInt) :: i, ph, homog, mySource
integer :: i, ph, homog, mySource
character(len=32) :: rankStr, PlasticItem, HomogItem
integer(HID_T) :: fileHandle, groupPlastic, groupHomog
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
write(6,'(a)') '<< CPFEM >> aging states'
crystallite_F0 = crystallite_partionedF
@ -246,14 +240,14 @@ subroutine CPFEM_age()
do mySource = 1,phase_Nsources(i)
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state
enddo; enddo
do homog = 1_pInt, material_Nhomogenization
do homog = 1, material_Nhomogenization
homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state
damageState (homog)%state0 = damageState (homog)%state
enddo
if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
write(rankStr,'(a1,i0)')'_',worldrank
@ -268,14 +262,14 @@ subroutine CPFEM_age()
call HDF5_write(fileHandle,crystallite_S0, 'convergedS')
groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
do ph = 1_pInt,size(phase_plasticity)
do ph = 1,size(phase_plasticity)
write(PlasticItem,*) ph,'_'
call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
enddo
call HDF5_closeGroup(groupPlastic)
groupHomog = HDF5_addGroup(fileHandle,'HomogStates')
do homog = 1_pInt, material_Nhomogenization
do homog = 1, material_Nhomogenization
write(HomogItem,*) homog,'_'
call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog')
enddo
@ -285,7 +279,7 @@ subroutine CPFEM_age()
restartWrite = .false.
endif
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
write(6,'(a)') '<< CPFEM >> done aging states'
end subroutine CPFEM_age
@ -295,23 +289,23 @@ end subroutine CPFEM_age
!> @brief triggers writing of the results
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_results(inc,time)
use prec, only: &
pInt
use results
use HDF5_utilities
use homogenization, only: &
homogenization_results
use constitutive, only: &
constitutive_results
use crystallite, only: &
crystallite_results
implicit none
integer(pInt), intent(in) :: inc
integer, intent(in) :: inc
real(pReal), intent(in) :: time
call results_openJobFile
call results_addIncrement(inc,time)
call constitutive_results
call crystallite_results
call homogenization_results
call results_removeLink('current') ! ToDo: put this into closeJobFile
call results_closeJobFile

7
src/DAMASK_interface.f90
View File

@ -14,7 +14,11 @@
#define PETSC_MAJOR 3
#define PETSC_MINOR_MIN 10
#define PETSC_MINOR_MAX 11
module DAMASK_interface
use, intrinsic :: iso_fortran_env
use PETScSys
use prec
use system_routines
@ -50,9 +54,6 @@ contains
!! information on computation to screen
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
use, intrinsic :: iso_fortran_env
use PETScSys
#include <petsc/finclude/petscsys.h>
#if defined(__GFORTRAN__) && __GNUC__<GCC_MIN
===================================================================================================

44
src/DAMASK_marc.f90
View File

@ -96,14 +96,12 @@ end subroutine DAMASK_interface_init
!> @brief solver job name (no extension) as combination of geometry and load case name
!--------------------------------------------------------------------------------------------------
function getSolverJobName()
use prec, only: &
pReal, &
pInt
use prec
implicit none
character(1024) :: getSolverJobName, inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
integer(pInt) :: extPos
integer :: extPos
getSolverJobName=''
inputName=''
@ -133,9 +131,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, &
strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
jtype,lclass,ifr,ifu)
use prec, only: &
pReal, &
pInt
use prec
use numerics, only: &
!$ DAMASK_NumThreadsInt, &
numerics_unitlength, &
@ -180,7 +176,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
implicit none
!$ include "omp_lib.h" ! the openMP function library
integer(pInt), intent(in) :: & ! according to MSC.Marc 2012 Manual D
integer, intent(in) :: & ! according to MSC.Marc 2012 Manual D
ngens, & !< size of stress-strain law
nn, & !< integration point number
ndi, & !< number of direct components
@ -193,7 +189,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
jtype, & !< element type
ifr, & !< set to 1 if R has been calculated
ifu !< set to 1 if stretch has been calculated
integer(pInt), dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D
integer, dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D
m, & !< (1) user element number, (2) internal element number
matus, & !< (1) user material identification number, (2) internal material identification number
kcus, & !< (1) layer number, (2) internal layer number
@ -236,10 +232,10 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
logical :: cutBack
real(pReal), dimension(6) :: stress
real(pReal), dimension(6,6) :: ddsdde
integer(pInt) :: computationMode, i, cp_en, node, CPnodeID
integer :: computationMode, i, cp_en, node, CPnodeID
!$ integer(4) :: defaultNumThreadsInt !< default value set by Marc
if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0_pInt) then
if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0) then
write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn
write(6,'(a,2(i1))') ' Jacobian: ', ngens,ngens
write(6,'(a,i1)') ' Direct stress: ', ndi
@ -260,7 +256,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
computationMode = 0_pInt ! save initialization value, since it does not result in any calculation
computationMode = 0 ! save initialization value, since it does not result in any calculation
if (lovl == 4 ) then ! jacobian requested by marc
if (timinc < theDelta .and. theInc == inc .and. lastLovl /= lovl) & ! first after cutback
computationMode = CPFEM_RESTOREJACOBIAN
@ -307,7 +303,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
if (lastLovl /= lovl) then ! first after ping pong
call debug_reset() ! resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1_pInt
cycleCounter = cycleCounter + 1
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
call mesh_build_ipCoordinates() ! update ip coordinates
endif
@ -324,7 +320,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
lastIncConverged = .false. ! reset flag
endif
do node = 1,theMesh%elem%nNodes
CPnodeID = mesh_element(4_pInt+node,cp_en)
CPnodeID = mesh_element(4+node,cp_en)
mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
enddo
endif
@ -336,7 +332,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
call debug_info() ! first reports (meaningful) debugging
call debug_reset() ! and resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1_pInt
cycleCounter = cycleCounter + 1
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
call mesh_build_ipCoordinates() ! update ip coordinates
endif
@ -376,9 +372,7 @@ end subroutine hypela2
!> @brief calculate internal heat generated due to inelastic energy dissipation
!--------------------------------------------------------------------------------------------------
subroutine flux(f,ts,n,time)
use prec, only: &
pReal, &
pInt
use prec
use thermal_conduction, only: &
thermal_conduction_getSourceAndItsTangent
use mesh, only: &
@ -387,7 +381,7 @@ subroutine flux(f,ts,n,time)
implicit none
real(pReal), dimension(6), intent(in) :: &
ts
integer(pInt), dimension(10), intent(in) :: &
integer, dimension(10), intent(in) :: &
n
real(pReal), intent(in) :: &
time
@ -404,9 +398,7 @@ subroutine flux(f,ts,n,time)
!> @details select a variable contour plotting (user subroutine).
!--------------------------------------------------------------------------------------------------
subroutine uedinc(inc,incsub)
use prec, only: &
pReal, &
pInt
use prec
use CPFEM, only: &
CPFEM_results
@ -424,9 +416,7 @@ end subroutine uedinc
!> @details select a variable contour plotting (user subroutine).
!--------------------------------------------------------------------------------------------------
subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
use prec, only: &
pReal, &
pInt
use prec
use mesh, only: &
mesh_FEasCP
use IO, only: &
@ -436,7 +426,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
materialpoint_sizeResults
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
m, & !< element number
nn, & !< integration point number
layer, & !< layer number
@ -453,7 +443,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
real(pReal), intent(out) :: &
v !< variable
if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd) ! complain about out of bounds error
if (jpltcd > materialpoint_sizeResults) call IO_error(700,jpltcd) ! complain about out of bounds error
v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m))
end subroutine plotv

57
src/FEsolving.f90
View File

@ -5,14 +5,12 @@
!> @todo Descriptions for public variables needed
!--------------------------------------------------------------------------------------------------
module FEsolving
use prec, only: &
pInt, &
pReal
use prec
implicit none
private
integer(pInt), public :: &
restartInc = 1_pInt !< needs description
integer, public :: &
restartInc = 1 !< needs description
logical, public :: &
symmetricSolver = .false., & !< use a symmetric FEM solver
@ -20,10 +18,10 @@ module FEsolving
restartRead = .false., & !< restart information to continue calculation from saved state
terminallyIll = .false. !< at least one material point is terminally ill
integer(pInt), dimension(:,:), allocatable, public :: &
integer, dimension(:,:), allocatable, public :: &
FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP
integer(pInt), dimension(2), public :: &
integer, dimension(2), public :: &
FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element
character(len=1024), public :: &
@ -59,13 +57,12 @@ subroutine FE_init
IO_warning
use DAMASK_interface
implicit none
#if defined(Marc4DAMASK) || defined(Abaqus)
integer(pInt), parameter :: &
FILEUNIT = 222_pInt
integer(pInt) :: j
integer, parameter :: &
FILEUNIT = 222
integer :: j
character(len=65536) :: tag, line
integer(pInt), allocatable, dimension(:) :: chunkPos
integer, allocatable, dimension(:) :: chunkPos
#endif
write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
@ -75,35 +72,35 @@ subroutine FE_init
#if defined(Grid) || defined(FEM)
restartInc = interface_RestartInc
if(restartInc < 0_pInt) then
call IO_warning(warning_ID=34_pInt)
restartInc = 0_pInt
if(restartInc < 0) then
call IO_warning(warning_ID=34)
restartInc = 0
endif
restartRead = restartInc > 0_pInt ! only read in if "true" restart requested
restartRead = restartInc > 0 ! only read in if "true" restart requested
#else
call IO_open_inputFile(FILEUNIT,modelName)
rewind(FILEUNIT)
do
read (FILEUNIT,'(a1024)',END=100) line
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
select case(tag)
case ('solver')
read (FILEUNIT,'(a1024)',END=100) line ! next line
chunkPos = IO_stringPos(line)
symmetricSolver = (IO_intValue(line,chunkPos,2_pInt) /= 1_pInt)
symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1)
case ('restart')
read (FILEUNIT,'(a1024)',END=100) line ! next line
chunkPos = IO_stringPos(line)
restartWrite = iand(IO_intValue(line,chunkPos,1_pInt),1_pInt) > 0_pInt
restartRead = iand(IO_intValue(line,chunkPos,1_pInt),2_pInt) > 0_pInt
restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0
restartRead = iand(IO_intValue(line,chunkPos,1),2) > 0
case ('*restart')
do j=2_pInt,chunkPos(1)
do j=2,chunkPos(1)
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite
restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead
enddo
if(restartWrite) then
do j=2_pInt,chunkPos(1)
do j=2,chunkPos(1)
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite
enddo
endif
@ -118,11 +115,11 @@ subroutine FE_init
do
read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line)
if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'restart' &
.and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'file' &
.and. IO_lc(IO_stringValue(line,chunkPos,3_pInt)) == 'job' &
.and. IO_lc(IO_stringValue(line,chunkPos,4_pInt)) == 'id' ) &
modelName = IO_StringValue(line,chunkPos,6_pInt)
if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'restart' &
.and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'file' &
.and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job' &
.and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) &
modelName = IO_StringValue(line,chunkPos,6)
enddo
#else ! QUESTION: is this meaningful for the spectral/FEM case?
call IO_open_inputFile(FILEUNIT,modelName)
@ -130,10 +127,10 @@ subroutine FE_init
do
read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line)
if (IO_lc(IO_stringValue(line,chunkPos,1_pInt))=='*heading') then
if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then
read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line)
modelName = IO_StringValue(line,chunkPos,1_pInt)
modelName = IO_StringValue(line,chunkPos,1)
endif
enddo
#endif
@ -141,7 +138,7 @@ subroutine FE_init
endif
#endif
if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0_pInt) then
if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then
write(6,'(a21,l1)') ' restart writing: ', restartWrite
write(6,'(a21,l1)') ' restart reading: ', restartRead
if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName)

10
src/HDF5_utilities.f90
View File

@ -8,6 +8,8 @@ module HDF5_utilities
use prec
use IO
use HDF5
use rotations
use numerics
#ifdef PETSc
use PETSC
#endif
@ -1676,8 +1678,6 @@ end subroutine HDF5_write_int7
! ToDo: We could optionally write out other representations (axis angle, euler, ...)
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel)
use rotations, only: &
rotation
type(rotation), intent(in), dimension(:) :: dataset
integer(HID_T), intent(in) :: loc_id !< file or group handle
@ -1754,9 +1754,6 @@ end subroutine HDF5_write_rotation
subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, globalShape, &
loc_id,localShape,datasetName,parallel)
use numerics, only: &
worldrank, &
worldsize
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
@ -1850,9 +1847,6 @@ end subroutine finalize_read
subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, &
loc_id,myShape,datasetName,datatype,parallel)
use numerics, only: &
worldrank, &
worldsize
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file

511
src/IO.f90
View File

File diff suppressed because it is too large Load Diff

18
src/Lambert.f90
View File

@ -38,11 +38,13 @@
!> Modeling and Simulations in Materials Science and Engineering 22, 075013 (2014).
!--------------------------------------------------------------------------
module Lambert
use prec
use math
implicit none
private
real(pReal), parameter, private :: &
real(pReal), parameter :: &
SPI = sqrt(PI), &
PREF = sqrt(6.0_pReal/PI), &
A = PI**(5.0_pReal/6.0_pReal)/6.0_pReal**(1.0_pReal/6.0_pReal), &
@ -55,10 +57,8 @@ module Lambert
PREK = R1 * 2.0_pReal**(1.0_pReal/4.0_pReal)/BETA
public :: &
LambertCubeToBall, &
LambertBallToCube
private :: &
GetPyramidOrder
Lambert_CubeToBall, &
Lambert_BallToCube
contains
@ -68,7 +68,7 @@ contains
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief map from 3D cubic grid to 3D ball
!--------------------------------------------------------------------------
function LambertCubeToBall(cube) result(ball)
function Lambert_CubeToBall(cube) result(ball)
real(pReal), intent(in), dimension(3) :: cube
real(pReal), dimension(3) :: ball, LamXYZ, XYZ
@ -116,7 +116,7 @@ function LambertCubeToBall(cube) result(ball)
endif center
end function LambertCubeToBall
end function Lambert_CubeToBall
!--------------------------------------------------------------------------
@ -124,7 +124,7 @@ end function LambertCubeToBall
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief map from 3D ball to 3D cubic grid
!--------------------------------------------------------------------------
pure function LambertBallToCube(xyz) result(cube)
pure function Lambert_BallToCube(xyz) result(cube)
real(pReal), intent(in), dimension(3) :: xyz
real(pReal), dimension(3) :: cube, xyz1, xyz3
@ -170,7 +170,7 @@ pure function LambertBallToCube(xyz) result(cube)
endif center
end function LambertBallToCube
end function Lambert_BallToCube
!--------------------------------------------------------------------------

2
src/commercialFEM_fileList.f90
View File

@ -46,7 +46,6 @@
#include "plastic_nonlocal.f90"
#include "constitutive.f90"
#include "crystallite.f90"
#include "homogenization_mech_RGC.f90"
#include "thermal_isothermal.f90"
#include "thermal_adiabatic.f90"
#include "thermal_conduction.f90"
@ -56,4 +55,5 @@
#include "homogenization.f90"
#include "homogenization_mech_none.f90"
#include "homogenization_mech_isostrain.f90"
#include "homogenization_mech_RGC.f90"
#include "CPFEM.f90"

53
src/config.f90
View File

@ -6,12 +6,14 @@
!! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture'
!--------------------------------------------------------------------------------------------------
module config
use prec, only: &
pReal
use list, only: &
tPartitionedStringList
use prec
use DAMASK_interface
use IO
use debug
use list
implicit none
private
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
config_phase, &
@ -24,6 +26,7 @@ module config
config_numerics, &
config_debug
!ToDo: bad names (how should one know that those variables are defined in config?)
character(len=64), dimension(:), allocatable, public, protected :: &
phase_name, & !< name of each phase
homogenization_name, & !< name of each homogenization
@ -47,22 +50,9 @@ contains
!> @brief reads material.config and stores its content per part
!--------------------------------------------------------------------------------------------------
subroutine config_init
use prec, only: &
pStringLen
use DAMASK_interface, only: &
getSolverJobName
use IO, only: &
IO_read_ASCII, &
IO_error, &
IO_lc, &
IO_getTag
use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic
implicit none
integer :: myDebug,i
integer :: i
logical :: verbose
character(len=pStringLen) :: &
line, &
@ -72,7 +62,7 @@ subroutine config_init
write(6,'(/,a)') ' <<<+- config init -+>>>'
myDebug = debug_level(debug_material)
verbose = iand(debug_level(debug_material),debug_levelBasic) /= 0
inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists)
if(fileExists) then
@ -92,23 +82,23 @@ subroutine config_init
case (trim('phase'))
call parse_materialConfig(phase_name,config_phase,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6)
if (verbose) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim('microstructure'))
call parse_materialConfig(microstructure_name,config_microstructure,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6)
if (verbose) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim('crystallite'))
call parse_materialConfig(crystallite_name,config_crystallite,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6)
if (verbose) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim('homogenization'))
call parse_materialConfig(homogenization_name,config_homogenization,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6)
if (verbose) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim('texture'))
call parse_materialConfig(texture_name,config_texture,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6)
if (verbose) write(6,'(a)') ' Texture parsed'; flush(6)
end select
@ -146,10 +136,7 @@ contains
!! Recursion is triggered by "{path/to/inputfile}" in a line
!--------------------------------------------------------------------------------------------------
recursive function read_materialConfig(fileName,cnt) result(fileContent)
use IO, only: &
IO_warning
implicit none
character(len=*), intent(in) :: fileName
integer, intent(in), optional :: cnt !< recursion counter
character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
@ -231,12 +218,7 @@ end function read_materialConfig
!--------------------------------------------------------------------------------------------------
subroutine parse_materialConfig(sectionNames,part,line, &
fileContent)
use prec, only: &
pStringLen
use IO, only: &
IO_intOut
implicit none
character(len=64), allocatable, dimension(:), intent(out) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part
character(len=pStringLen), intent(inout) :: line
@ -288,7 +270,7 @@ end subroutine parse_materialConfig
!--------------------------------------------------------------------------------------------------
subroutine parse_debugAndNumericsConfig(config_list, &
fileContent)
implicit none
type(tPartitionedStringList), intent(out) :: config_list
character(len=pStringLen), dimension(:), intent(in) :: fileContent
integer :: i
@ -306,10 +288,7 @@ end subroutine config_init
!> @brief deallocates the linked lists that store the content of the configuration files
!--------------------------------------------------------------------------------------------------
subroutine config_deallocate(what)
use IO, only: &
IO_error
implicit none
character(len=*), intent(in) :: what
select case(trim(what))

479
src/crystallite.f90
View File

@ -9,37 +9,43 @@
!--------------------------------------------------------------------------------------------------
module crystallite
use prec, only: &
pReal, &
pStringLen
use rotations, only: &
rotation
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP
use material, only: &
homogenization_Ngrains
use prec
use IO
use config
use debug
use numerics
use rotations
use math
use mesh
use FEsolving
use material
use constitutive
use lattice
use future
use plastic_nonlocal
#if defined(PETSc) || defined(DAMASK_HDF5)
use HDF5_utilities
use results
#endif
implicit none
private
character(len=64), dimension(:,:), allocatable, private :: &
character(len=64), dimension(:,:), allocatable :: &
crystallite_output !< name of each post result output
integer, public, protected :: &
crystallite_maxSizePostResults !< description not available
integer, dimension(:), allocatable, public, protected :: &
crystallite_sizePostResults !< description not available
integer, dimension(:,:), allocatable, private :: &
integer, dimension(:,:), allocatable :: &
crystallite_sizePostResult !< description not available
real(pReal), dimension(:,:,:), allocatable, public :: &
crystallite_dt !< requested time increment of each grain
real(pReal), dimension(:,:,:), allocatable, private :: &
real(pReal), dimension(:,:,:), allocatable :: &
crystallite_subdt, & !< substepped time increment of each grain
crystallite_subFrac, & !< already calculated fraction of increment
crystallite_subStep !< size of next integration step
type(rotation), dimension(:,:,:), allocatable, private :: &
type(rotation), dimension(:,:,:), allocatable :: &
crystallite_orientation, & !< orientation
crystallite_orientation0 !< initial orientation
real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: &
@ -64,7 +70,7 @@ module crystallite
crystallite_Li, & !< current intermediate velocitiy grad (end of converged time step)
crystallite_Li0, & !< intermediate velocitiy grad at start of FE inc
crystallite_partionedLi0 !< intermediate velocity grad at start of homog inc
real(pReal), dimension(:,:,:,:,:), allocatable, private :: &
real(pReal), dimension(:,:,:,:,:), allocatable :: &
crystallite_subS0, & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc
crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step)
crystallite_subFp0,& !< plastic def grad at start of crystallite inc
@ -78,7 +84,7 @@ module crystallite
crystallite_dPdF !< current individual dPdF per grain (end of converged time step)
logical, dimension(:,:,:), allocatable, public :: &
crystallite_requested !< used by upper level (homogenization) to request crystallite calculation
logical, dimension(:,:,:), allocatable, private :: &
logical, dimension(:,:,:), allocatable :: &
crystallite_converged, & !< convergence flag
crystallite_todo, & !< flag to indicate need for further computation
crystallite_localPlasticity !< indicates this grain to have purely local constitutive law
@ -102,14 +108,32 @@ module crystallite
neighboringip_ID, &
neighboringelement_ID
end enum
integer(kind(undefined_ID)),dimension(:,:), allocatable, private :: &
integer(kind(undefined_ID)),dimension(:,:), allocatable :: &
crystallite_outputID !< ID of each post result output
type, private :: tOutput !< new requested output (per phase)
type :: tOutput !< new requested output (per phase)
character(len=65536), allocatable, dimension(:) :: &
label
end type tOutput
type(tOutput), allocatable, dimension(:), private :: output_constituent
type(tOutput), allocatable, dimension(:) :: output_constituent
type :: tNumerics
integer :: &
iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp
nState, & !< state loop limit
nStress !< stress loop limit
real(pReal) :: &
subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback
subStepSizeCryst, & !< size of first substep when cutback
subStepSizeLp, & !< size of first substep when cutback in Lp calculation
subStepSizeLi, & !< size of first substep when cutback in Li calculation
stepIncreaseCryst, & !< increase of next substep size when previous substep converged
rTol_crystalliteState, & !< relative tolerance in state loop
rTol_crystalliteStress, & !< relative tolerance in stress loop
aTol_crystalliteStress !< absolute tolerance in stress loop
end type tNumerics
type(tNumerics) :: num ! numerics parameters. Better name?
procedure(), pointer :: integrateState
@ -121,15 +145,6 @@ module crystallite
crystallite_push33ToRef, &
crystallite_postResults, &
crystallite_results
private :: &
integrateStress, &
integrateState, &
integrateStateFPI, &
integrateStateEuler, &
integrateStateAdaptiveEuler, &
integrateStateRK4, &
integrateStateRKCK45, &
stateJump
contains
@ -138,40 +153,6 @@ contains
!> @brief allocates and initialize per grain variables
!--------------------------------------------------------------------------------------------------
subroutine crystallite_init
#ifdef DEBUG
use debug, only: &
debug_info, &
debug_reset, &
debug_level, &
debug_crystallite, &
debug_levelBasic
#endif
use numerics, only: &
numerics_integrator, &
worldrank, &
usePingPong
use math, only: &
math_I3, &
math_EulerToR, &
math_inv33
use mesh, only: &
theMesh, &
mesh_element
use IO, only: &
IO_stringValue, &
IO_write_jobFile, &
IO_error
use material
use config, only: &
config_deallocate, &
config_crystallite, &
config_phase, &
crystallite_name
use constitutive, only: &
constitutive_initialFi, &
constitutive_microstructure ! derived (shortcut) quantities of given state
implicit none
integer, parameter :: FILEUNIT=434
logical, dimension(:,:), allocatable :: devNull
@ -243,6 +224,38 @@ subroutine crystallite_init
allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), &
size(config_crystallite)), source=0)
num%subStepMinCryst = config_numerics%getFloat('substepmincryst', defaultVal=1.0e-3_pReal)
num%subStepSizeCryst = config_numerics%getFloat('substepsizecryst', defaultVal=0.25_pReal)
num%stepIncreaseCryst = config_numerics%getFloat('stepincreasecryst', defaultVal=1.5_pReal)
num%subStepSizeLp = config_numerics%getFloat('substepsizelp', defaultVal=0.5_pReal)
num%subStepSizeLi = config_numerics%getFloat('substepsizeli', defaultVal=0.5_pReal)
num%rTol_crystalliteState = config_numerics%getFloat('rtol_crystallitestate', defaultVal=1.0e-6_pReal)
num%rTol_crystalliteStress = config_numerics%getFloat('rtol_crystallitestress',defaultVal=1.0e-6_pReal)
num%aTol_crystalliteStress = config_numerics%getFloat('atol_crystallitestress',defaultVal=1.0e-8_pReal)
num%iJacoLpresiduum = config_numerics%getInt ('ijacolpresiduum', defaultVal=1)
num%nState = config_numerics%getInt ('nstate', defaultVal=20)
num%nStress = config_numerics%getInt ('nstress', defaultVal=40)
if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst')
if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst')
if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst')
if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp')
if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi')
if(num%rTol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteState')
if(num%rTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteStress')
if(num%aTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='aTol_crystalliteStress')
if(num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum')
if(num%nState < 1) call IO_error(301,ext_msg='nState')
if(num%nStress< 1) call IO_error(301,ext_msg='nStress')
select case(numerics_integrator)
case(1)
integrateState => integrateStateFPI
@ -430,40 +443,7 @@ end subroutine crystallite_init
!> @brief calculate stress (P)
!--------------------------------------------------------------------------------------------------
function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
use prec, only: &
tol_math_check, &
dNeq0
use numerics, only: &
subStepMinCryst, &
subStepSizeCryst, &
stepIncreaseCryst
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_crystallite, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective, &
debug_e, &
debug_i, &
debug_g
#endif
use IO, only: &
IO_warning, &
IO_error
use math, only: &
math_inv33
use mesh, only: &
theMesh, &
mesh_element
use material, only: &
homogenization_Ngrains, &
plasticState, &
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt
implicit none
logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress
real(pReal), intent(in), optional :: &
dummyArgumentToPreventInternalCompilerErrorWithGCC
@ -519,7 +499,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
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) = 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_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst
crystallite_todo(c,i,e) = .true.
crystallite_converged(c,i,e) = .false. ! pretend failed step of 1/subStepSizeCryst
endif homogenizationRequestsCalculation
@ -554,7 +534,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
formerSubStep = crystallite_subStep(c,i,e)
crystallite_subFrac(c,i,e) = crystallite_subFrac(c,i,e) + crystallite_subStep(c,i,e)
crystallite_subStep(c,i,e) = min(1.0_pReal - crystallite_subFrac(c,i,e), &
stepIncreaseCryst * crystallite_subStep(c,i,e))
num%stepIncreaseCryst * crystallite_subStep(c,i,e))
crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal ! still time left to integrate on?
if (crystallite_todo(c,i,e)) then
@ -584,7 +564,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
!--------------------------------------------------------------------------------------------------
! cut back (reduced time and restore)
else
crystallite_subStep(c,i,e) = subStepSizeCryst * crystallite_subStep(c,i,e)
crystallite_subStep(c,i,e) = num%subStepSizeCryst * crystallite_subStep(c,i,e)
crystallite_Fp (1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e)
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)
@ -602,7 +582,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
enddo
! cant restore dotState here, since not yet calculated in first cutback after initialization
crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst ! still on track or already done (beyond repair)
crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > num%subStepMinCryst ! still on track or already done (beyond repair)
#ifdef DEBUG
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0 &
.and. ((e == debug_e .and. i == debug_i .and. c == debug_g) &
@ -652,7 +632,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
!--------------------------------------------------------------------------------------------------
! integrate --- requires fully defined state array (basic + dependent state)
if (any(crystallite_todo)) call integrateState ! TODO: unroll into proper elementloop to avoid N^2 for single point evaluation
where(.not. crystallite_converged .and. crystallite_subStep > subStepMinCryst) & ! do not try non-converged but fully cutbacked any further
where(.not. crystallite_converged .and. crystallite_subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further
crystallite_todo = .true. ! TODO: again unroll this into proper elementloop to avoid N^2 for single point evaluation
@ -702,33 +682,8 @@ end function crystallite_stress
!--------------------------------------------------------------------------------------------------
!> @brief calculate tangent (dPdF)
!--------------------------------------------------------------------------------------------------
subroutine crystallite_stressTangent()
use prec, only: &
tol_math_check, &
dNeq0
use IO, only: &
IO_warning, &
IO_error
use math, only: &
math_inv33, &
math_identity2nd, &
math_3333to99, &
math_99to3333, &
math_I3, &
math_mul3333xx3333, &
math_mul33xx33, &
math_invert2, &
math_det33
use mesh, only: &
mesh_element
use material, only: &
homogenization_Ngrains
use constitutive, only: &
constitutive_SandItsTangents, &
constitutive_LpAndItsTangents, &
constitutive_LiAndItsTangents
subroutine crystallite_stressTangent
implicit none
integer :: &
c, & !< counter in integration point component loop
i, & !< counter in integration point loop
@ -868,21 +823,7 @@ end subroutine crystallite_stressTangent
!> @brief calculates orientations
!--------------------------------------------------------------------------------------------------
subroutine crystallite_orientations
use math, only: &
math_rotationalPart33, &
math_RtoQ
use material, only: &
plasticState, &
material_phase, &
homogenization_Ngrains
use mesh, only: &
mesh_element
use lattice, only: &
lattice_qDisorientation
use plastic_nonlocal, only: &
plastic_nonlocal_updateCompatibility
implicit none
integer &
c, & !< counter in integration point component loop
i, & !< counter in integration point loop
@ -919,7 +860,6 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33)
use material, only: &
material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0
implicit none
real(pReal), dimension(3,3) :: crystallite_push33ToRef
real(pReal), dimension(3,3), intent(in) :: tensor33
real(pReal), dimension(3,3) :: T
@ -939,30 +879,7 @@ end function crystallite_push33ToRef
!> @brief return results of particular grain
!--------------------------------------------------------------------------------------------------
function crystallite_postResults(ipc, ip, el)
use math, only: &
math_det33, &
math_I3, &
inDeg
use mesh, only: &
theMesh, &
mesh_element, &
mesh_ipVolume, &
mesh_ipNeighborhood
use material, only: &
plasticState, &
sourceState, &
microstructure_crystallite, &
crystallite_Noutput, &
material_phase, &
material_texture, &
homogenization_Ngrains
use constitutive, only: &
constitutive_homogenizedC, &
constitutive_postResults
use rotations, only: &
rotation
implicit none
integer, intent(in):: &
el, & !< element index
ip, & !< integration point index
@ -1079,17 +996,9 @@ end function crystallite_postResults
!--------------------------------------------------------------------------------------------------
subroutine crystallite_results
#if defined(PETSc) || defined(DAMASK_HDF5)
use lattice
use results
use HDF5_utilities
use rotations
use config, only: &
config_name_phase => phase_name ! anticipate logical name
use material, only: &
material_phase_plasticity_type => phase_plasticity
implicit none
integer :: p,o
real(pReal), allocatable, dimension(:,:,:) :: selected_tensors
type(rotation), allocatable, dimension(:) :: selected_rotations
@ -1229,41 +1138,7 @@ end subroutine crystallite_results
!> intermediate acceleration of the Newton-Raphson correction
!--------------------------------------------------------------------------------------------------
logical function integrateStress(ipc,ip,el,timeFraction)
use, intrinsic :: &
IEEE_arithmetic
use prec, only: tol_math_check, &
dEq0
use numerics, only: nStress, &
aTol_crystalliteStress, &
rTol_crystalliteStress, &
iJacoLpresiduum, &
subStepSizeLp, &
subStepSizeLi
#ifdef DEBUG
use debug, only: debug_level, &
debug_e, &
debug_i, &
debug_g, &
debug_crystallite, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective
#endif
use constitutive, only: constitutive_LpAndItsTangents, &
constitutive_LiAndItsTangents, &
constitutive_SandItsTangents
use math, only: math_mul33xx33, &
math_mul3333xx3333, &
math_inv33, &
math_det33, &
math_I3, &
math_identity2nd, &
math_3333to99, &
math_33to9, &
math_9to33
implicit none
integer, intent(in):: el, & ! element index
ip, & ! integration point index
ipc ! grain index
@ -1382,10 +1257,10 @@ logical function integrateStress(ipc,ip,el,timeFraction)
LiLoop: do
NiterationStressLi = NiterationStressLi + 1
LiLoopLimit: if (NiterationStressLi > nStress) then
LiLoopLimit: if (NiterationStressLi > num%nStress) then
#ifdef DEBUG
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) &
write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Li loop limit',nStress, &
write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Li loop limit',num%nStress, &
' at el ip ipc ', el,ip,ipc
#endif
return
@ -1404,10 +1279,10 @@ logical function integrateStress(ipc,ip,el,timeFraction)
LpLoop: do
NiterationStressLp = NiterationStressLp + 1
LpLoopLimit: if (NiterationStressLp > nStress) then
LpLoopLimit: if (NiterationStressLp > num%nStress) then
#ifdef DEBUG
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) &
write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Lp loop limit',nStress, &
write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Lp loop limit',num%nStress, &
' at el ip ipc ', el,ip,ipc
#endif
return
@ -1438,8 +1313,8 @@ logical function integrateStress(ipc,ip,el,timeFraction)
#endif
!* update current residuum and check for convergence of loop
aTolLp = max(rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error
aTol_crystalliteStress) ! minimum lower cutoff
aTolLp = max(num%rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error
num%aTol_crystalliteStress) ! minimum lower cutoff
residuumLp = Lpguess - Lp_constitutive
if (any(IEEE_is_NaN(residuumLp))) then
@ -1459,7 +1334,7 @@ logical function integrateStress(ipc,ip,el,timeFraction)
Lpguess_old = Lpguess
steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved...
steplengthLp = subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction
steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction
Lpguess = Lpguess_old + steplengthLp * deltaLp
#ifdef DEBUG
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0 &
@ -1473,7 +1348,7 @@ logical function integrateStress(ipc,ip,el,timeFraction)
!* calculate Jacobian for correction term
if (mod(jacoCounterLp, iJacoLpresiduum) == 0) then
if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then
do o=1,3; do p=1,3
dFe_dLp(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
enddo; enddo
@ -1537,8 +1412,8 @@ logical function integrateStress(ipc,ip,el,timeFraction)
#endif
!* update current residuum and check for convergence of loop
aTolLi = max(rTol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error
aTol_crystalliteStress) ! minimum lower cutoff
aTolLi = max(num%rTol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error
num%aTol_crystalliteStress) ! minimum lower cutoff
residuumLi = Liguess - Li_constitutive
if (any(IEEE_is_NaN(residuumLi))) then ! NaN in residuum...
#ifdef DEBUG
@ -1557,13 +1432,13 @@ logical function integrateStress(ipc,ip,el,timeFraction)
Liguess_old = Liguess
steplengthLi = 1.0_pReal ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved...
steplengthLi = subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction
steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction
Liguess = Liguess_old + steplengthLi * deltaLi
cycle LiLoop
endif
!* calculate Jacobian for correction term
if (mod(jacoCounterLi, iJacoLpresiduum) == 0) then
if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then
temp_33 = matmul(matmul(A,B),invFi_current)
do o=1,3; do p=1,3
dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
@ -1661,32 +1536,7 @@ end function integrateStress
!> @brief integrate stress, state with adaptive 1st order explicit Euler method
!> using Fixed Point Iteration to adapt the stepsize
!--------------------------------------------------------------------------------------------------
subroutine integrateStateFPI()
#ifdef DEBUG
use debug, only: debug_level, &
debug_e, &
debug_i, &
debug_g, &
debug_crystallite, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective
#endif
use numerics, only: &
nState
use mesh, only: &
mesh_element
use material, only: &
plasticState, &
sourceState, &
phaseAt, phasememberAt, &
phase_Nsources, &
homogenization_Ngrains
use constitutive, only: &
constitutive_plasticity_maxSizeDotState, &
constitutive_source_maxSizeDotState
implicit none
subroutine integrateStateFPI
integer :: &
NiterationState, & !< number of iterations in state loop
@ -1712,7 +1562,7 @@ subroutine integrateStateFPI()
NiterationState = 0
doneWithIntegration = .false.
crystalliteLooping: do while (.not. doneWithIntegration .and. NiterationState < nState)
crystalliteLooping: do while (.not. doneWithIntegration .and. NiterationState < num%nState)
NiterationState = NiterationState + 1
#ifdef DEBUG
@ -1852,7 +1702,6 @@ subroutine integrateStateFPI()
!--------------------------------------------------------------------------------------------------
real(pReal) pure function damper(current,previous,previous2)
implicit none
real(pReal), dimension(:), intent(in) ::&
current, previous, previous2
@ -1874,11 +1723,7 @@ end subroutine integrateStateFPI
!--------------------------------------------------------------------------------------------------
!> @brief integrate state with 1st order explicit Euler method
!--------------------------------------------------------------------------------------------------
subroutine integrateStateEuler()
use material, only: &
plasticState
implicit none
subroutine integrateStateEuler
call update_dotState(1.0_pReal)
call update_state(1.0_pReal)
@ -1894,22 +1739,8 @@ end subroutine integrateStateEuler
!--------------------------------------------------------------------------------------------------
!> @brief integrate stress, state with 1st order Euler method with adaptive step size
!--------------------------------------------------------------------------------------------------
subroutine integrateStateAdaptiveEuler()
use mesh, only: &
theMesh, &
mesh_element
use material, only: &
homogenization_Ngrains, &
plasticState, &
sourceState, &
phaseAt, phasememberAt, &
phase_Nsources, &
homogenization_maxNgrains
use constitutive, only: &
constitutive_plasticity_maxSizeDotState, &
constitutive_source_maxSizeDotState
subroutine integrateStateAdaptiveEuler
implicit none
integer :: &
e, & ! element index in element loop
i, & ! integration point index in ip loop
@ -2001,17 +1832,8 @@ end subroutine integrateStateAdaptiveEuler
!> @brief integrate stress, state with 4th order explicit Runge Kutta method
! ToDo: This is totally BROKEN: RK4dotState is never used!!!
!--------------------------------------------------------------------------------------------------
subroutine integrateStateRK4()
use mesh, only: &
mesh_element
use material, only: &
homogenization_Ngrains, &
plasticState, &
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt
subroutine integrateStateRK4
implicit none
real(pReal), dimension(4), parameter :: &
TIMESTEPFRACTION = [0.5_pReal, 0.5_pReal, 1.0_pReal, 1.0_pReal] ! factor giving the fraction of the original timestep used for Runge Kutta Integration
real(pReal), dimension(4), parameter :: &
@ -2069,22 +1891,8 @@ end subroutine integrateStateRK4
!> @brief integrate stress, state with 5th order Runge-Kutta Cash-Karp method with
!> adaptive step size (use 5th order solution to advance = "local extrapolation")
!--------------------------------------------------------------------------------------------------
subroutine integrateStateRKCK45()
use mesh, only: &
mesh_element, &
theMesh
use material, only: &
homogenization_Ngrains, &
plasticState, &
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt, &
homogenization_maxNgrains
use constitutive, only: &
constitutive_plasticity_maxSizeDotState, &
constitutive_source_maxSizeDotState
subroutine integrateStateRKCK45
implicit none
real(pReal), dimension(5,5), parameter :: &
A = reshape([&
.2_pReal, .075_pReal, .3_pReal, -11.0_pReal/54.0_pReal, 1631.0_pReal/55296.0_pReal, &
@ -2252,9 +2060,7 @@ end subroutine integrateStateRKCK45
!> @brief sets convergence flag for nonlocal calculations
!> @detail one non-converged nonlocal sets all other nonlocals to non-converged to trigger cut back
!--------------------------------------------------------------------------------------------------
subroutine nonlocalConvergenceCheck()
implicit none
subroutine nonlocalConvergenceCheck
if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)...
where( .not. crystallite_localPlasticity) crystallite_converged = .false.
@ -2267,10 +2073,8 @@ end subroutine nonlocalConvergenceCheck
! still .true. is considered as converged
!> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria
!--------------------------------------------------------------------------------------------------
subroutine setConvergenceFlag()
use mesh, only: &
mesh_element
implicit none
subroutine setConvergenceFlag
integer :: &
e, & !< element index in element loop
i, & !< integration point index in ip loop
@ -2291,14 +2095,13 @@ end subroutine setConvergenceFlag
!> @brief determines whether a point is converged
!--------------------------------------------------------------------------------------------------
logical pure function converged(residuum,state,aTol)
use prec, only: &
dEq0
use numerics, only: &
rTol => rTol_crystalliteState
implicit none
real(pReal), intent(in), dimension(:) ::&
residuum, state, aTol
real(pReal) :: &
rTol
rTol = num%rTol_crystalliteState
converged = all(abs(residuum) <= max(aTol, rTol*abs(state)))
@ -2309,9 +2112,7 @@ end subroutine setConvergenceFlag
!> @brief Standard forwarding of state as state = state0 + dotState * (delta t)
!--------------------------------------------------------------------------------------------------
subroutine update_stress(timeFraction)
use mesh, only: &
mesh_element
implicit none
real(pReal), intent(in) :: &
timeFraction
integer :: &
@ -2341,13 +2142,10 @@ end subroutine update_stress
!--------------------------------------------------------------------------------------------------
!> @brief tbd
!--------------------------------------------------------------------------------------------------
subroutine update_dependentState()
use mesh, only: &
mesh_element
subroutine update_dependentState
use constitutive, only: &
constitutive_dependentState => constitutive_microstructure
implicit none
integer :: e, & ! element index in element loop
i, & ! integration point index in ip loop
g ! grain index in grain loop
@ -2370,15 +2168,7 @@ end subroutine update_dependentState
!> @brief Standard forwarding of state as state = state0 + dotState * (delta t)
!--------------------------------------------------------------------------------------------------
subroutine update_state(timeFraction)
use material, only: &
plasticState, &
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt
use mesh, only: &
mesh_element
implicit none
real(pReal), intent(in) :: &
timeFraction
integer :: &
@ -2419,19 +2209,7 @@ end subroutine update_state
!> if NaN occurs, crystallite_todo is set to FALSE. Any NaN in a nonlocal propagates to all others
!--------------------------------------------------------------------------------------------------
subroutine update_dotState(timeFraction)
use, intrinsic :: &
IEEE_arithmetic
use material, only: &
plasticState, &
sourceState, &
phaseAt, phasememberAt, &
phase_Nsources
use mesh, only: &
mesh_element
use constitutive, only: &
constitutive_collectDotState
implicit none
real(pReal), intent(in) :: &
timeFraction
integer :: &
@ -2477,20 +2255,7 @@ end subroutine update_DotState
subroutine update_deltaState
use, intrinsic :: &
IEEE_arithmetic
use prec, only: &
dNeq0
use mesh, only: &
mesh_element
use material, only: &
plasticState, &
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt
use constitutive, only: &
constitutive_collectDeltaState
implicit none
integer :: &
e, & !< element index in element loop
i, & !< integration point index in ip loop
@ -2555,31 +2320,7 @@ end subroutine update_deltaState
!> returns true, if state jump was successfull or not needed. false indicates NaN in delta state
!--------------------------------------------------------------------------------------------------
logical function stateJump(ipc,ip,el)
use, intrinsic :: &
IEEE_arithmetic
use prec, only: &
dNeq0
#ifdef DEBUG
use debug, only: &
debug_e, &
debug_i, &
debug_g, &
debug_level, &
debug_crystallite, &
debug_levelExtensive, &
debug_levelSelective
#endif
use material, only: &
plasticState, &
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt
use mesh, only: &
mesh_element
use constitutive, only: &
constitutive_collectDeltaState
implicit none
integer, intent(in):: &
el, & ! element index
ip, & ! integration point index

99
src/damage_local.f90
View File

@ -3,42 +3,43 @@
!> @brief material subroutine for locally evolving damage field
!--------------------------------------------------------------------------------------------------
module damage_local
use prec, only: &
pReal, &
pInt
use prec
use material
use numerics
use config
implicit none
private
integer(pInt), dimension(:,:), allocatable, target, public :: &
integer, dimension(:,:), allocatable, target, public :: &
damage_local_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
damage_local_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
integer, dimension(:), allocatable, target, public :: &
damage_local_Noutput !< number of outputs per instance of this damage
enum, bind(c)
enumerator :: undefined_ID, &
damage_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
integer(kind(undefined_ID)), dimension(:,:), allocatable :: &
damage_local_outputID !< ID of each post result output
type, private :: tParameters
type :: tParameters
integer(kind(undefined_ID)), dimension(:), allocatable :: &
outputID
end type tParameters
type(tparameters), dimension(:), allocatable, private :: &
type(tparameters), dimension(:), allocatable :: &
param
public :: &
damage_local_init, &
damage_local_updateState, &
damage_local_postResults
private :: &
damage_local_getSourceAndItsTangent
contains
@ -47,26 +48,10 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine damage_local_init
use material, only: &
damage_type, &
damage_typeInstance, &
homogenization_Noutput, &
DAMAGE_local_label, &
DAMAGE_local_ID, &
material_homogenizationAt, &
mappingHomogenization, &
damageState, &
damageMapping, &
damage, &
damage_initialPhi
use config, only: &
config_homogenization
implicit none
integer(pInt) :: maxNinstance,homog,instance,o,i
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog, h
integer :: maxNinstance,homog,instance,i
integer :: sizeState
integer :: NofMyHomog, h
integer(kind(undefined_ID)) :: &
outputID
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
@ -75,14 +60,14 @@ subroutine damage_local_init
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'
maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt)
if (maxNinstance == 0_pInt) return
maxNinstance = count(damage_type == DAMAGE_local_ID)
if (maxNinstance == 0) return
allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
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)
allocate(damage_local_Noutput (maxNinstance), source=0)
allocate(param(maxNinstance))
@ -116,7 +101,7 @@ subroutine damage_local_init
! allocate state arrays
sizeState = 1_pInt
sizeState = 1
damageState(homog)%sizeState = sizeState
damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance))
allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog))
@ -138,24 +123,15 @@ end subroutine damage_local_init
!> @brief calculates local change in damage field
!--------------------------------------------------------------------------------------------------
function damage_local_updateState(subdt, ip, el)
use numerics, only: &
residualStiffness, &
err_damage_tolAbs, &
err_damage_tolRel
use material, only: &
material_homogenizationAt, &
mappingHomogenization, &
damageState
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
subdt
logical, dimension(2) :: &
damage_local_updateState
integer(pInt) :: &
integer :: &
homog, &
offset
real(pReal) :: &
@ -181,17 +157,6 @@ end function damage_local_updateState
!> @brief calculates homogenized local damage driving forces
!--------------------------------------------------------------------------------------------------
subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
use material, only: &
homogenization_Ngrains, &
material_homogenizationAt, &
phaseAt, &
phasememberAt, &
phase_source, &
phase_Nsources, &
SOURCE_damage_isoBrittle_ID, &
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID
use source_damage_isoBrittle, only: &
source_damage_isobrittle_getRateAndItsTangent
use source_damage_isoDuctile, only: &
@ -201,13 +166,12 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
use source_damage_anisoDuctile, only: &
source_damage_anisoductile_getRateAndItsTangent
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
phi
integer(pInt) :: &
integer :: &
phase, &
grain, &
source, &
@ -249,37 +213,32 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
end subroutine damage_local_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of damage results
!--------------------------------------------------------------------------------------------------
function damage_local_postResults(ip,el)
use material, only: &
material_homogenizationAt, &
damage_typeInstance, &
damageMapping, &
damage
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
damage_local_postResults
integer(pInt) :: &
integer :: &
instance, homog, offset, o, c
homog = material_homogenizationAt(el)
offset = damageMapping(homog)%p(ip,el)
instance = damage_typeInstance(homog)
associate(prm => param(instance))
c = 0_pInt
c = 0
outputsLoop: do o = 1_pInt,size(prm%outputID)
outputsLoop: do o = 1,size(prm%outputID)
select case(prm%outputID(o))
case (damage_ID)
damage_local_postResults(c+1_pInt) = damage(homog)%p(offset)
damage_local_postResults(c+1) = damage(homog)%p(offset)
c = c + 1
end select
enddo outputsLoop

15
src/damage_none.f90
View File

@ -3,6 +3,8 @@
!> @brief material subroutine for constant damage field
!--------------------------------------------------------------------------------------------------
module damage_none
use config
use material
implicit none
private
@ -15,19 +17,8 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine damage_none_init()
use config, only: &
config_homogenization
use material, only: &
damage_initialPhi, &
damage, &
damage_type, &
material_homogenizationAt, &
damageState, &
DAMAGE_NONE_LABEL, &
DAMAGE_NONE_ID
subroutine damage_none_init
implicit none
integer :: &
homog, &
NofMyHomog

138
src/damage_nonlocal.f90
View File

@ -4,19 +4,28 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module damage_nonlocal
use prec, only: &
pReal, &
pInt
use prec
use material
use numerics
use config
use crystallite
use lattice
use mesh
use source_damage_isoBrittle
use source_damage_isoDuctile
use source_damage_anisoBrittle
use source_damage_anisoDuctile
implicit none
private
integer(pInt), dimension(:,:), allocatable, target, public :: &
integer, dimension(:,:), allocatable, target, public :: &
damage_nonlocal_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
damage_nonlocal_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
integer, dimension(:), allocatable, target, public :: &
damage_nonlocal_Noutput !< number of outputs per instance of this damage
enum, bind(c)
@ -24,12 +33,12 @@ module damage_nonlocal
damage_ID
end enum
type, private :: tParameters
type :: tParameters
integer(kind(undefined_ID)), dimension(:), allocatable :: &
outputID
end type tParameters
type(tparameters), dimension(:), allocatable, private :: &
type(tparameters), dimension(:), allocatable :: &
param
public :: &
@ -47,26 +56,10 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine damage_nonlocal_init
use material, only: &
damage_type, &
damage_typeInstance, &
homogenization_Noutput, &
DAMAGE_nonlocal_label, &
DAMAGE_nonlocal_ID, &
material_homogenizationAt, &
mappingHomogenization, &
damageState, &
damageMapping, &
damage, &
damage_initialPhi
use config, only: &
config_homogenization
implicit none
integer(pInt) :: maxNinstance,homog,instance,o,i
integer(pInt) :: sizeState
integer(pInt) :: NofMyHomog, h
integer :: maxNinstance,homog,instance,o,i
integer :: sizeState
integer :: NofMyHomog, h
integer(kind(undefined_ID)) :: &
outputID
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
@ -75,13 +68,13 @@ subroutine damage_nonlocal_init
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>'
maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt)
if (maxNinstance == 0_pInt) return
maxNinstance = count(damage_type == DAMAGE_nonlocal_ID)
if (maxNinstance == 0) return
allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance))
damage_nonlocal_output = ''
allocate(damage_nonlocal_Noutput (maxNinstance), source=0_pInt)
allocate(damage_nonlocal_Noutput (maxNinstance), source=0)
allocate(param(maxNinstance))
@ -114,7 +107,7 @@ subroutine damage_nonlocal_init
! allocate state arrays
sizeState = 1_pInt
sizeState = 1
damageState(homog)%sizeState = sizeState
damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance))
allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog))
@ -130,37 +123,18 @@ subroutine damage_nonlocal_init
enddo
end subroutine damage_nonlocal_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates homogenized damage driving forces
!--------------------------------------------------------------------------------------------------
subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
use material, only: &
homogenization_Ngrains, &
material_homogenizationAt, &
phaseAt, &
phasememberAt, &
phase_source, &
phase_Nsources, &
SOURCE_damage_isoBrittle_ID, &
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID
use source_damage_isoBrittle, only: &
source_damage_isobrittle_getRateAndItsTangent
use source_damage_isoDuctile, only: &
source_damage_isoductile_getRateAndItsTangent
use source_damage_anisoBrittle, only: &
source_damage_anisobrittle_getRateAndItsTangent
use source_damage_anisoDuctile, only: &
source_damage_anisoductile_getRateAndItsTangent
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
phi
integer(pInt) :: &
integer :: &
phase, &
grain, &
source, &
@ -202,28 +176,18 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
end subroutine damage_nonlocal_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized non local damage diffusion tensor in reference configuration
!--------------------------------------------------------------------------------------------------
function damage_nonlocal_getDiffusion33(ip,el)
use numerics, only: &
charLength
use lattice, only: &
lattice_DamageDiffusion33
use material, only: &
homogenization_Ngrains, &
material_phase, &
material_homogenizationAt
use crystallite, only: &
crystallite_push33ToRef
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), dimension(3,3) :: &
damage_nonlocal_getDiffusion33
integer(pInt) :: &
integer :: &
homog, &
grain
@ -235,27 +199,20 @@ function damage_nonlocal_getDiffusion33(ip,el)
enddo
damage_nonlocal_getDiffusion33 = &
charLength**2_pInt*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
end function damage_nonlocal_getDiffusion33
!--------------------------------------------------------------------------------------------------
!> @brief Returns homogenized nonlocal damage mobility
!--------------------------------------------------------------------------------------------------
real(pReal) function damage_nonlocal_getMobility(ip,el)
use mesh, only: &
mesh_element
use lattice, only: &
lattice_damageMobility
use material, only: &
material_phase, &
homogenization_Ngrains
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
integer(pInt) :: &
integer :: &
ipc
damage_nonlocal_getMobility = 0.0_pReal
@ -269,22 +226,18 @@ real(pReal) function damage_nonlocal_getMobility(ip,el)
end function damage_nonlocal_getMobility
!--------------------------------------------------------------------------------------------------
!> @brief updated nonlocal damage field with solution from damage phase field PDE
!--------------------------------------------------------------------------------------------------
subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el)
use material, only: &
material_homogenizationAt, &
damageMapping, &
damage
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
phi
integer(pInt) :: &
integer :: &
homog, &
offset
@ -294,37 +247,32 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el)
end subroutine damage_nonlocal_putNonLocalDamage
!--------------------------------------------------------------------------------------------------
!> @brief return array of damage results
!--------------------------------------------------------------------------------------------------
function damage_nonlocal_postResults(ip,el)
use material, only: &
material_homogenizationAt, &
damage_typeInstance, &
damageMapping, &
damage
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ip, & !< integration point
el !< element
real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
damage_nonlocal_postResults
integer(pInt) :: &
integer :: &
instance, homog, offset, o, c
homog = material_homogenizationAt(el)
offset = damageMapping(homog)%p(ip,el)
instance = damage_typeInstance(homog)
associate(prm => param(instance))
c = 0_pInt
c = 0
outputsLoop: do o = 1_pInt,size(prm%outputID)
outputsLoop: do o = 1,size(prm%outputID)
select case(prm%outputID(o))
case (damage_ID)
damage_nonlocal_postResults(c+1_pInt) = damage(homog)%p(offset)
damage_nonlocal_postResults(c+1) = damage(homog)%p(offset)
c = c + 1
end select
enddo outputsLoop

22
src/debug.f90
View File

@ -6,12 +6,12 @@
!> @brief Reading in and interpretating the debugging settings for the various modules
!--------------------------------------------------------------------------------------------------
module debug
use prec, only: &
pInt, &
pReal
use prec
use IO
implicit none
private
integer(pInt), parameter, public :: &
debug_LEVELSELECTIVE = 2_pInt**0_pInt, &
debug_LEVELBASIC = 2_pInt**1_pInt, &
@ -78,19 +78,7 @@ contains
!> @brief reads in parameters from debug.config and allocates arrays
!--------------------------------------------------------------------------------------------------
subroutine debug_init
use prec, only: &
pStringLen
use IO, only: &
IO_read_ASCII, &
IO_error, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_lc, &
IO_floatValue, &
IO_intValue
implicit none
character(len=pStringLen), dimension(:), allocatable :: fileContent
integer :: i, what, j
@ -253,8 +241,6 @@ end subroutine debug_init
!--------------------------------------------------------------------------------------------------
subroutine debug_reset
implicit none
debug_stressMaxLocation = 0_pInt
debug_stressMinLocation = 0_pInt
debug_jacobianMaxLocation = 0_pInt
@ -272,8 +258,6 @@ end subroutine debug_reset
!--------------------------------------------------------------------------------------------------
subroutine debug_info
implicit none
!$OMP CRITICAL (write2out)
debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 &
.and. any(debug_stressMinLocation /= 0_pInt) &

4
src/element.f90
View File

@ -3,8 +3,7 @@
!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH
!--------------------------------------------------------------------------------------------------
module element
use prec, only: &
pReal
use prec
implicit none
private
@ -802,7 +801,6 @@ module element
use IO, only: &
IO_error
implicit none
class(tElement) :: self
integer, intent(in) :: elemType
self%elemType = elemType

274
src/grid/DAMASK_grid.f90
View File

@ -9,69 +9,19 @@
program DAMASK_spectral
#include <petsc/finclude/petscsys.h>
use PETScsys
use prec, only: &
pInt, &
pLongInt, &
pReal, &
tol_math_check, &
dNeq
use DAMASK_interface, only: &
DAMASK_interface_init, &
loadCaseFile, &
geometryFile, &
getSolverJobName, &
interface_restartInc
use IO, only: &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_error, &
IO_lc, &
IO_intOut, &
IO_warning
use config, only: &
config_numerics
use debug, only: &
debug_level, &
debug_spectral, &
debug_levelBasic
use math ! need to include the whole module for FFTW
use mesh, only: &
grid, &
geomSize
use CPFEM2, only: &
CPFEM_initAll, &
CPFEM_results
use FEsolving, only: &
restartWrite, &
restartInc
use numerics, only: &
worldrank, &
worldsize, &
stagItMax, &
maxCutBack, &
continueCalculation
use homogenization, only: &
materialpoint_sizeResults, &
materialpoint_results, &
materialpoint_postResults
use material, only: &
thermal_type, &
damage_type, &
THERMAL_conduction_ID, &
DAMAGE_nonlocal_ID
use spectral_utilities, only: &
utilities_init, &
tSolutionState, &
tLoadCase, &
cutBack, &
nActiveFields, &
FIELD_UNDEFINED_ID, &
FIELD_MECH_ID, &
FIELD_THERMAL_ID, &
FIELD_DAMAGE_ID
use prec
use DAMASK_interface
use IO
use config
use debug
use math
use mesh
use CPFEM2
use FEsolving
use numerics
use homogenization
use material
use spectral_utilities
use grid_mech_spectral_basic
use grid_mech_spectral_polarisation
use grid_mech_FEM
@ -86,11 +36,11 @@ program DAMASK_spectral
! variables related to information from load case and geom file
real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
N_t = 0_pInt, & !< # of time indicators found in load case file
N_n = 0_pInt, & !< # of increment specifiers found in load case file
N_def = 0_pInt !< # of rate of deformation specifiers found in load case file
integer, allocatable, dimension(:) :: chunkPos
integer :: &
N_t = 0, & !< # of time indicators found in load case file
N_n = 0, & !< # of increment specifiers found in load case file
N_def = 0 !< # of rate of deformation specifiers found in load case file
character(len=65536) :: &
line
@ -99,8 +49,8 @@ program DAMASK_spectral
real(pReal), dimension(3,3), parameter :: &
ones = 1.0_pReal, &
zeros = 0.0_pReal
integer(pInt), parameter :: &
subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0
integer, parameter :: &
subStepFactor = 2 !< for each substep, divide the last time increment by 2.0
real(pReal) :: &
time = 0.0_pReal, & !< elapsed time
time0 = 0.0_pReal, & !< begin of interval
@ -110,21 +60,21 @@ program DAMASK_spectral
logical :: &
guess, & !< guess along former trajectory
stagIterate
integer(pInt) :: &
integer :: &
i, j, k, l, field, &
errorID = 0_pInt, &
cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0_pInt !< fraction of current time interval
integer(pInt) :: &
currentLoadcase = 0_pInt, & !< current load case
errorID = 0, &
cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0 !< fraction of current time interval
integer :: &
currentLoadcase = 0, & !< current load case
inc, & !< current increment in current load case
totalIncsCounter = 0_pInt, & !< total # of increments
convergedCounter = 0_pInt, & !< # of converged increments
notConvergedCounter = 0_pInt, & !< # of non-converged increments
fileUnit = 0_pInt, & !< file unit for reading load case and writing results
totalIncsCounter = 0, & !< total # of increments
convergedCounter = 0, & !< # of converged increments
notConvergedCounter = 0, & !< # of non-converged increments
fileUnit = 0, & !< file unit for reading load case and writing results
myStat, &
statUnit = 0_pInt, & !< file unit for statistics output
lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written
statUnit = 0, & !< file unit for statistics output
lastRestartWritten = 0, & !< total increment # at which last restart information was written
stagIter
character(len=6) :: loadcase_string
character(len=1024) :: &
@ -134,8 +84,8 @@ program DAMASK_spectral
type(tSolutionState), allocatable, dimension(:) :: solres
integer(MPI_OFFSET_KIND) :: fileOffset
integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize
integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
integer(pInt), parameter :: maxRealOut = maxByteOut/pReal
integer, parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
integer, parameter :: maxRealOut = maxByteOut/pReal
integer(pLongInt), dimension(2) :: outputIndex
PetscErrorCode :: ierr
procedure(grid_mech_spectral_basic_init), pointer :: &
@ -174,20 +124,20 @@ program DAMASK_spectral
case ('polarisation')
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
call IO_warning(42_pInt, ext_msg='debug Divergence')
call IO_warning(42, ext_msg='debug Divergence')
mech_init => grid_mech_spectral_polarisation_init
mech_forward => grid_mech_spectral_polarisation_forward
mech_solution => grid_mech_spectral_polarisation_solution
case ('fem')
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
call IO_warning(42_pInt, ext_msg='debug Divergence')
call IO_warning(42, ext_msg='debug Divergence')
mech_init => grid_mech_FEM_init
mech_forward => grid_mech_FEM_forward
mech_solution => grid_mech_FEM_solution
case default
call IO_error(error_ID = 891_pInt, ext_msg = config_numerics%getString('spectral_solver'))
call IO_error(error_ID = 891, ext_msg = config_numerics%getString('spectral_solver'))
end select
@ -195,27 +145,27 @@ program DAMASK_spectral
! reading information from load case file and to sanity checks
allocate (loadCases(0)) ! array of load cases
open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile))
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=trim(loadCaseFile))
do
read(fileUnit, '(A)', iostat=myStat) line
if ( myStat /= 0_pInt) exit
if ( myStat /= 0) exit
if (IO_isBlank(line)) cycle ! skip empty lines
currentLoadCase = currentLoadCase + 1_pInt
currentLoadCase = currentLoadCase + 1
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase
do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f')
N_def = N_def + 1_pInt
N_def = N_def + 1
case('t','time','delta')
N_t = N_t + 1_pInt
N_t = N_t + 1
case('n','incs','increments','steps','logincs','logincrements','logsteps')
N_n = N_n + 1_pInt
N_n = N_n + 1
end select
enddo
if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check
call IO_error(error_ID=837_pInt,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase
if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1) & ! sanity check
call IO_error(error_ID=837,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase
newLoadCase%stress%myType='stress'
field = 1
@ -229,7 +179,7 @@ program DAMASK_spectral
newLoadCase%ID(field) = FIELD_DAMAGE_ID
endif damageActive
readIn: do i = 1_pInt, chunkPos(1)
readIn: do i = 1, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix
temp_valueVector = 0.0_pReal
@ -241,7 +191,7 @@ program DAMASK_spectral
else
newLoadCase%deformation%myType = 'l'
endif
do j = 1_pInt, 9_pInt
do j = 1, 9
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a *
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
enddo
@ -250,7 +200,7 @@ program DAMASK_spectral
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
do j = 1, 9
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
enddo
@ -258,54 +208,54 @@ program DAMASK_spectral
newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical)
newLoadCase%stress%values = math_9to33(temp_valueVector)
case('t','time','delta') ! increment time
newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt)
newLoadCase%time = IO_floatValue(line,chunkPos,i+1)
case('n','incs','increments','steps') ! number of increments
newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt)
newLoadCase%incs = IO_intValue(line,chunkPos,i+1)
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt)
newLoadCase%logscale = 1_pInt
newLoadCase%incs = IO_intValue(line,chunkPos,i+1)
newLoadCase%logscale = 1
case('freq','frequency','outputfreq') ! frequency of result writings
newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1)
case('r','restart','restartwrite') ! frequency of writing restart information
newLoadCase%restartfrequency = &
max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt))
max(0,IO_intValue(line,chunkPos,i+1))
case('guessreset','dropguessing')
newLoadCase%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
case('euler') ! rotation of load case given in euler angles
temp_valueVector = 0.0_pReal
l = 1_pInt ! assuming values given in degrees
k = 1_pInt ! assuming keyword indicating degree/radians present
select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt)))
l = 1 ! assuming values given in degrees
k = 1 ! assuming keyword indicating degree/radians present
select case (IO_lc(IO_stringValue(line,chunkPos,i+1)))
case('deg','degree')
case('rad','radian') ! don't convert from degree to radian
l = 0_pInt
l = 0
case default
k = 0_pInt
k = 0
end select
do j = 1_pInt, 3_pInt
do j = 1, 3
temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j)
enddo
if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad
if (l == 1) temp_valueVector(1:3) = temp_valueVector(1:3) * INRAD ! convert to rad
newLoadCase%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix
case('rotation','rot') ! assign values for the rotation matrix
temp_valueVector = 0.0_pReal
do j = 1_pInt, 9_pInt
do j = 1, 9
temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j)
enddo
newLoadCase%rotation = math_9to33(temp_valueVector)
end select
enddo readIn
newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt) ! by default, guess from previous load case
newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1) ! by default, guess from previous load case
reportAndCheck: if (worldrank == 0) then
write (loadcase_string, '(i6)' ) currentLoadCase
write(6,'(/,1x,a,i6)') 'load case: ', currentLoadCase
if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory'
if (newLoadCase%deformation%myType == 'l') then
do j = 1_pInt, 3_pInt
do j = 1, 3
if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt ! each row should be either fully or not at all defined
any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832 ! each row should be either fully or not at all defined
enddo
write(6,'(2x,a)') 'velocity gradient:'
else if (newLoadCase%deformation%myType == 'f') then
@ -313,7 +263,7 @@ program DAMASK_spectral
else
write(6,'(2x,a)') 'deformation gradient rate:'
endif
do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
do i = 1, 3; do j = 1, 3
if(newLoadCase%deformation%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') newLoadCase%deformation%values(i,j)
else
@ -322,13 +272,13 @@ program DAMASK_spectral
enddo; write(6,'(/)',advance='no')
enddo
if (any(newLoadCase%stress%maskLogical .eqv. &
newLoadCase%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
newLoadCase%deformation%maskLogical)) errorID = 831 ! exclusive or masking only
if (any(newLoadCase%stress%maskLogical .and. &
transpose(newLoadCase%stress%maskLogical) .and. &
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
errorID = 838_pInt ! no rotation is allowed by stress BC
errorID = 838 ! no rotation is allowed by stress BC
write(6,'(2x,a)') 'stress / GPa:'
do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
do i = 1, 3; do j = 1, 3
if(newLoadCase%stress%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal
else
@ -340,18 +290,18 @@ program DAMASK_spectral
transpose(newLoadCase%rotation))-math_I3) > &
reshape(spread(tol_math_check,1,9),[ 3,3]))&
.or. abs(math_det33(newLoadCase%rotation)) > &
1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain
1.0_pReal + tol_math_check) errorID = 846 ! given rotation matrix contains strain
if (any(dNeq(newLoadCase%rotation, math_I3))) &
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
transpose(newLoadCase%rotation)
if (newLoadCase%time < 0.0_pReal) errorID = 834_pInt ! negative time increment
if (newLoadCase%time < 0.0_pReal) errorID = 834 ! negative time increment
write(6,'(2x,a,f12.6)') 'time: ', newLoadCase%time
if (newLoadCase%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
if (newLoadCase%incs < 1) errorID = 835 ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs
if (newLoadCase%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
if (newLoadCase%outputfrequency < 1) errorID = 836 ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency
write(6,'(2x,a,i5)') 'restart frequency: ', newLoadCase%restartfrequency
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
endif reportAndCheck
loadCases = [loadCases,newLoadCase] ! load case is ok, append it
enddo
@ -383,7 +333,7 @@ program DAMASK_spectral
!--------------------------------------------------------------------------------------------------
! write header of output file
if (worldrank == 0) then
writeHeader: if (interface_restartInc < 1_pInt) then
writeHeader: if (interface_restartInc < 1) then
open(newunit=fileUnit,file=trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE')
write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header
@ -417,59 +367,59 @@ program DAMASK_spectral
allocate(outputSize(worldsize), source = 0_MPI_OFFSET_KIND)
outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND)
call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce')
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_allreduce')
call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', &
MPI_MODE_WRONLY + MPI_MODE_APPEND, &
MPI_INFO_NULL, &
fileUnit, &
ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open')
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_open')
call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position')
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_get_position')
fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me)
call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek')
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_seek')
writeUndeformed: if (interface_restartInc < 1_pInt) then
writeUndeformed: if (interface_restartInc < 1) then
write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
call CPFEM_results(0_pInt,0.0_pReal)
call CPFEM_results(0,0.0_pReal)
do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1?
outputIndex = int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, &
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), &
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write')
if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_write')
enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
endif writeUndeformed
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
loadCaseLooping: do currentLoadCase = 1, size(loadCases)
time0 = time ! load case start time
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1_pInt
incLooping: do inc = 1, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1
!--------------------------------------------------------------------------------------------------
! forwarding time
timeIncOld = timeinc ! last timeinc that brought former inc to an end
if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale
if (loadCases(currentLoadCase)%logscale == 0) then ! linear scale
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
else
if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale
if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
if (currentLoadCase == 1) then ! 1st load case of logarithmic scale
if (inc == 1) then ! 1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
else ! not-1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal))
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal))
endif
else ! not-1st load case of logarithmic scale
timeinc = time0 * &
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal))&
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt ,pReal)/&
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1 ,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal)))
endif
endif
@ -479,12 +429,12 @@ program DAMASK_spectral
time = time + timeinc ! just advance time, skip already performed calculation
guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference
else skipping
stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
time = time + timeinc ! forward target time
stepFraction = stepFraction + 1_pInt ! count step
stepFraction = stepFraction + 1 ! count step
!--------------------------------------------------------------------------------------------------
! report begin of new step
@ -524,7 +474,7 @@ program DAMASK_spectral
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 0_pInt
stagIter = 0
stagIterate = .true.
do while (stagIterate)
do field = 1, nActiveFields
@ -546,7 +496,7 @@ program DAMASK_spectral
if (.not. solres(field)%converged) exit ! no solution found
enddo
stagIter = stagIter + 1_pInt
stagIter = stagIter + 1
stagIterate = stagIter < stagItMax &
.and. all(solres(:)%converged) &
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
@ -567,52 +517,52 @@ program DAMASK_spectral
endif
elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated?
cutBack = .true.
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1_pInt
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1
time = time - timeinc ! rewind time
timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep
write(6,'(/,a)') ' cutting back '
else ! no more options to continue
call IO_warning(850_pInt)
call IO_warning(850)
call MPI_file_close(fileUnit,ierr)
close(statUnit)
call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written
call quit(-1*(lastRestartWritten+1)) ! quit and provide information about last restart inc written
endif
enddo subStepLooping
cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc
cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc
if (all(solres(:)%converged)) then
convergedCounter = convergedCounter + 1_pInt
convergedCounter = convergedCounter + 1
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc
' increment ', totalIncsCounter, ' converged'
else
notConvergedCounter = notConvergedCounter + 1_pInt
notConvergedCounter = notConvergedCounter + 1
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
' increment ', totalIncsCounter, ' NOT converged'
endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency
write(6,'(1/,a)') ' ... writing results to file ......................................'
flush(6)
call materialpoint_postResults()
call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek')
if (ierr /= 0) call IO_error(894, ext_msg='MPI_file_seek')
do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, &
outputIndex=int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, &
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),&
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write')
if(ierr /=0) call IO_error(894, ext_msg='MPI_file_write')
enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
call CPFEM_results(totalIncsCounter,time)
endif
if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ...
.and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information
if ( loadCases(currentLoadCase)%restartFrequency > 0 & ! writing of restart info requested ...
.and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! ... and at frequency of writing restart information
restartWrite = .true. ! set restart parameter for FEsolving
lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write?
endif
@ -636,7 +586,7 @@ program DAMASK_spectral
call MPI_file_close(fileUnit,ierr)
close(statUnit)
if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged
call quit(0_pInt) ! no complains ;)
if (notConvergedCounter > 0) call quit(2) ! error if some are not converged
call quit(0) ! no complains ;)
end program DAMASK_spectral

484
src/homogenization.f90
View File

@ -5,8 +5,27 @@
!> @brief homogenization manager, organizing deformation partitioning and stress homogenization
!--------------------------------------------------------------------------------------------------
module homogenization
use prec, only: &
pReal
use prec
use IO
use config
use debug
use math
use material
use numerics
use constitutive
use crystallite
use mesh
use FEsolving
use thermal_isothermal
use thermal_adiabatic
use thermal_conduction
use damage_none
use damage_local
use damage_nonlocal
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
use HDF5_utilities
#endif
!--------------------------------------------------------------------------------------------------
! General variables for the homogenization at a material point
@ -22,7 +41,6 @@ module homogenization
materialpoint_results !< results array of material point
integer, public, protected :: &
materialpoint_sizeResults, &
homogenization_maxSizePostResults, &
thermal_maxSizePostResults, &
damage_maxSizePostResults
@ -47,11 +65,24 @@ module homogenization
module subroutine mech_isostrain_init
end subroutine mech_isostrain_init
module subroutine mech_RGC_init
end subroutine mech_RGC_init
module subroutine mech_isostrain_partitionDeformation(F,avgF)
real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
end subroutine mech_isostrain_partitionDeformation
module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
integer, intent(in) :: &
instance, &
of
end subroutine mech_RGC_partitionDeformation
module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point
real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point
@ -61,17 +92,43 @@ module homogenization
integer, intent(in) :: instance
end subroutine mech_isostrain_averageStressAndItsTangent
module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point
real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point
real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses
real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
integer, intent(in) :: instance
end subroutine mech_RGC_averageStressAndItsTangent
module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
logical, dimension(2) :: mech_RGC_updateState
real(pReal), dimension(:,:,:), intent(in) :: &
P,& !< partitioned stresses
F,& !< partitioned deformation gradients
F0 !< partitioned initial deformation gradients
real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
real(pReal), dimension(3,3), intent(in) :: avgF !< average F
real(pReal), intent(in) :: dt !< time increment
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
end function mech_RGC_updateState
module subroutine mech_RGC_results(instance,group)
integer, intent(in) :: instance !< homogenization instance
character(len=*), intent(in) :: group !< group name in HDF5 file
end subroutine mech_RGC_results
end interface
public :: &
homogenization_init, &
materialpoint_stressAndItsTangent, &
materialpoint_postResults
private :: &
partitionDeformation, &
updateState, &
averageStressAndItsTangent, &
postResults
materialpoint_postResults, &
homogenization_results
contains
@ -80,39 +137,7 @@ contains
!> @brief module initialization
!--------------------------------------------------------------------------------------------------
subroutine homogenization_init
use math, only: &
math_I3
use debug, only: &
debug_level, &
debug_homogenization, &
debug_levelBasic, &
debug_e, &
debug_g
use mesh, only: &
theMesh, &
mesh_element
use constitutive, only: &
constitutive_plasticity_maxSizePostResults, &
constitutive_source_maxSizePostResults
use crystallite, only: &
crystallite_maxSizePostResults
use config, only: &
config_deallocate, &
config_homogenization, &
homogenization_name
use material
use homogenization_mech_RGC
use thermal_isothermal
use thermal_adiabatic
use thermal_conduction
use damage_none
use damage_local
use damage_nonlocal
use IO
use numerics, only: &
worldrank
implicit none
integer, parameter :: FILEUNIT = 200
integer :: e,i,p
integer, dimension(:,:), pointer :: thisSize
@ -121,10 +146,9 @@ subroutine homogenization_init
character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready
logical :: valid
if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init
if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init
if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call homogenization_RGC_init
if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init
if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init
if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init
@ -136,39 +160,14 @@ subroutine homogenization_init
!--------------------------------------------------------------------------------------------------
! write description file for homogenization output
mainProcess2: if (worldrank == 0) then
mainProcess: if (worldrank == 0) then
call IO_write_jobFile(FILEUNIT,'outputHomogenization')
do p = 1,size(config_homogenization)
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
case (HOMOGENIZATION_NONE_ID)
outputName = HOMOGENIZATION_NONE_label
thisOutput => null()
thisSize => null()
case (HOMOGENIZATION_ISOSTRAIN_ID)
outputName = HOMOGENIZATION_ISOSTRAIN_label
thisOutput => null()
thisSize => null()
case (HOMOGENIZATION_RGC_ID)
outputName = HOMOGENIZATION_RGC_label
thisOutput => homogenization_RGC_output
thisSize => homogenization_RGC_sizePostResult
case default
valid = .false.
end select
write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']'
if (valid) then
write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName)
write(FILEUNIT,'(a)') '(type) n/a'
write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p)
if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID .and. &
homogenization_type(p) /= HOMOGENIZATION_ISOSTRAIN_ID) then
do e = 1,size(thisOutput(:,i))
write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
enddo
endif
endif
i = thermal_typeInstance(p) ! which instance of this thermal type
valid = .true. ! assume valid
select case(thermal_type(p)) ! split per thermal type
@ -198,6 +197,7 @@ subroutine homogenization_init
enddo
endif
endif
i = damage_typeInstance(p) ! which instance of this damage type
valid = .true. ! assume valid
select case(damage_type(p)) ! split per damage type
@ -230,7 +230,7 @@ subroutine homogenization_init
endif
enddo
close(FILEUNIT)
endif mainProcess2
endif mainProcess
call config_deallocate('material.config/homogenization')
@ -253,18 +253,15 @@ subroutine homogenization_init
!--------------------------------------------------------------------------------------------------
! allocate and initialize global state and postresutls variables
homogenization_maxSizePostResults = 0
thermal_maxSizePostResults = 0
damage_maxSizePostResults = 0
do p = 1,size(config_homogenization)
homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults)
thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults)
damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults)
enddo
materialpoint_sizeResults = 1 & ! grain count
+ 1 + homogenization_maxSizePostResults & ! homogSize & homogResult
+ thermal_maxSizePostResults &
+ 1 + thermal_maxSizePostResults &
+ damage_maxSizePostResults &
+ homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results
+ 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results
@ -274,11 +271,6 @@ subroutine homogenization_init
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then
#ifdef TODO
write(6,'(a32,1x,7(i8,1x))') 'homogenization_state0: ', shape(homogenization_state0)
write(6,'(a32,1x,7(i8,1x))') 'homogenization_subState0: ', shape(homogenization_subState0)
write(6,'(a32,1x,7(i8,1x))') 'homogenization_state: ', shape(homogenization_state)
#endif
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF)
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F0: ', shape(materialpoint_F0)
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F: ', shape(materialpoint_F)
@ -291,7 +283,6 @@ subroutine homogenization_init
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested)
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged)
write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy)
write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', homogenization_maxSizePostResults
endif
flush(6)
@ -305,64 +296,7 @@ end subroutine homogenization_init
!> @brief parallelized calculation of stress and corresponding tangent at material points
!--------------------------------------------------------------------------------------------------
subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
use numerics, only: &
subStepMinHomog, &
subStepSizeHomog, &
stepIncreaseHomog, &
nMPstate
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP, &
terminallyIll
use mesh, only: &
mesh_element
use material, only: &
plasticState, &
sourceState, &
homogState, &
thermalState, &
damageState, &
phase_Nsources, &
material_homogenizationAt, &
mappingHomogenization, &
phaseAt, phasememberAt, &
homogenization_Ngrains
use crystallite, only: &
crystallite_F0, &
crystallite_Fp0, &
crystallite_Fp, &
crystallite_Fi0, &
crystallite_Fi, &
crystallite_Lp0, &
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_S0, &
crystallite_S, &
crystallite_partionedF0, &
crystallite_partionedF, &
crystallite_partionedFp0, &
crystallite_partionedLp0, &
crystallite_partionedFi0, &
crystallite_partionedLi0, &
crystallite_partionedS0, &
crystallite_dt, &
crystallite_requested, &
crystallite_stress, &
crystallite_stressTangent, &
crystallite_orientations
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_homogenization, &
debug_levelBasic, &
debug_levelExtensive, &
debug_levelSelective, &
debug_e, &
debug_i
#endif
implicit none
real(pReal), intent(in) :: dt !< time increment
logical, intent(in) :: updateJaco !< initiating Jacobian update
integer :: &
@ -389,7 +323,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
! initialize restoration points of ...
do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do g = 1,myNgrains
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e);
do g = 1,myNgrains
plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = &
plasticState (phaseAt(g,i,e))%state0( :,phasememberAt(g,i,e))
@ -398,34 +333,36 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
sourceState(phaseAt(g,i,e))%p(mySource)%state0( :,phasememberAt(g,i,e))
enddo
crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) ! ...plastic def grads
crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) ! ...plastic velocity grads
crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) ! ...intermediate def grads
crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) ! ...intermediate velocity grads
crystallite_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
crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e)
crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e)
crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e)
crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e)
crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e)
crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e)
enddo; enddo
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e))
materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) ! ...def grad
enddo
materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e)
materialpoint_subFrac(i,e) = 0.0_pReal
materialpoint_subStep(i,e) = 1.0_pReal/subStepSizeHomog ! <<added to adopt flexibility in cutback size>>
materialpoint_converged(i,e) = .false. ! pretend failed step of twice the required size
materialpoint_requested(i,e) = .true. ! everybody requires calculation
endforall
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
homogState(material_homogenizationAt(e))%sizeState > 0) &
if (homogState(material_homogenizationAt(e))%sizeState > 0) &
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(material_homogenizationAt(e))%sizeState > 0) &
if (thermalState(material_homogenizationAt(e))%sizeState > 0) &
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(material_homogenizationAt(e))%sizeState > 0) &
if (damageState(material_homogenizationAt(e))%sizeState > 0) &
damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state
enddo
enddo
NiterationHomog = 0
cutBackLooping: do while (.not. terminallyIll .and. &
@ -436,7 +373,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
myNgrains = homogenization_Ngrains(mesh_element(3,e))
IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
converged: if ( materialpoint_converged(i,e) ) then
converged: if (materialpoint_converged(i,e)) then
#ifdef DEBUG
if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 &
.and. ((e == debug_e .and. i == debug_i) &
@ -456,46 +393,45 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
steppingNeeded: if (materialpoint_subStep(i,e) > subStepMinHomog) then
! wind forward grain starting point of...
crystallite_partionedF0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) ! ...def grads
crystallite_partionedF0 (1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedF(1:3,1:3,1:myNgrains,i,e)
crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_Fp(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads
crystallite_partionedFp0 (1:3,1:3,1:myNgrains,i,e) = &
crystallite_Fp (1:3,1:3,1:myNgrains,i,e)
crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_Lp(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads
crystallite_partionedLp0 (1:3,1:3,1:myNgrains,i,e) = &
crystallite_Lp (1:3,1:3,1:myNgrains,i,e)
crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_Fi(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads
crystallite_partionedFi0 (1:3,1:3,1:myNgrains,i,e) = &
crystallite_Fi (1:3,1:3,1:myNgrains,i,e)
crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_Li(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads
crystallite_partionedLi0 (1:3,1:3,1:myNgrains,i,e) = &
crystallite_Li (1:3,1:3,1:myNgrains,i,e)
crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) = &
crystallite_S(1:3,1:3,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)
do g = 1,myNgrains
plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = &
plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e))
plasticState (phaseAt(g,i,e))%state (:,phasememberAt(g,i,e))
do mySource = 1, phase_Nsources(phaseAt(g,i,e))
sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = &
sourceState(phaseAt(g,i,e))%p(mySource)%state( :,phasememberAt(g,i,e))
sourceState(phaseAt(g,i,e))%p(mySource)%state (:,phasememberAt(g,i,e))
enddo
enddo
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
homogState(material_homogenizationAt(e))%sizeState > 0) &
if(homogState(material_homogenizationAt(e))%sizeState > 0) &
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(material_homogenizationAt(e))%sizeState > 0) &
homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e))
if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
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(material_homogenizationAt(e))%sizeState > 0) &
thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e))
if(damageState(material_homogenizationAt(e))%sizeState > 0) &
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
damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e))
materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e)
endif steppingNeeded
else converged
@ -526,16 +462,18 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
!--------------------------------------------------------------------------------------------------
! restore...
crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads
if (materialpoint_subStep(i,e) < 1.0_pReal) then ! protect against fake cutback from \Delta t = 2 to 1. Maybe that "trick" is not necessary anymore at all? I.e. start with \Delta t = 1
crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads
crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads
crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e)
crystallite_Li(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads
crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e)
endif ! maybe protecting everything from overwriting (not only L) makes even more sense
crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e)
crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e)
crystallite_S(1:3,1:3,1:myNgrains,i,e) = &
crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress
crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e)
do g = 1, myNgrains
plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) = &
plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e))
@ -544,18 +482,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e))
enddo
enddo
forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
homogState(material_homogenizationAt(e))%sizeState > 0) &
if(homogState(material_homogenizationAt(e))%sizeState > 0) &
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(material_homogenizationAt(e))%sizeState > 0) &
homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))
if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
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(material_homogenizationAt(e))%sizeState > 0) &
thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))
if(damageState(material_homogenizationAt(e))%sizeState > 0) &
damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = &
damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state
damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))
endif
endif converged
@ -653,26 +588,7 @@ end subroutine materialpoint_stressAndItsTangent
!> @brief parallelized calculation of result array at material points
!--------------------------------------------------------------------------------------------------
subroutine materialpoint_postResults
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP
use mesh, only: &
mesh_element
use material, only: &
material_homogenizationAt, &
homogState, &
thermalState, &
damageState, &
plasticState, &
sourceState, &
material_phase, &
homogenization_Ngrains, &
microstructure_crystallite
use crystallite, only: &
crystallite_sizePostResults, &
crystallite_postResults
implicit none
integer :: &
thePos, &
theSize, &
@ -721,20 +637,7 @@ end subroutine materialpoint_postResults
!> @brief partition material point def grad onto constituents
!--------------------------------------------------------------------------------------------------
subroutine partitionDeformation(ip,el)
use mesh, only: &
mesh_element
use material, only: &
homogenization_type, &
homogenization_Ngrains, &
HOMOGENIZATION_NONE_ID, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_RGC_ID
use crystallite, only: &
crystallite_partionedF
use homogenization_mech_RGC, only: &
homogenization_RGC_partitionDeformation
implicit none
integer, intent(in) :: &
ip, & !< integration point
el !< element number
@ -750,7 +653,7 @@ subroutine partitionDeformation(ip,el)
materialpoint_subF(1:3,1:3,ip,el))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call homogenization_RGC_partitionDeformation(&
call mech_RGC_partitionDeformation(&
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
materialpoint_subF(1:3,1:3,ip,el),&
ip, &
@ -765,29 +668,7 @@ end subroutine partitionDeformation
!> "happy" with result
!--------------------------------------------------------------------------------------------------
function updateState(ip,el)
use mesh, only: &
mesh_element
use material, only: &
homogenization_type, &
thermal_type, &
damage_type, &
homogenization_Ngrains, &
HOMOGENIZATION_RGC_ID, &
THERMAL_adiabatic_ID, &
DAMAGE_local_ID
use crystallite, only: &
crystallite_P, &
crystallite_dPdF, &
crystallite_partionedF,&
crystallite_partionedF0
use homogenization_mech_RGC, only: &
homogenization_RGC_updateState
use thermal_adiabatic, only: &
thermal_adiabatic_updateState
use damage_local, only: &
damage_local_updateState
implicit none
integer, intent(in) :: &
ip, & !< integration point
el !< element number
@ -798,7 +679,7 @@ function updateState(ip,el)
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
updateState = &
updateState .and. &
homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),&
materialpoint_subF(1:3,1:3,ip,el),&
@ -833,21 +714,7 @@ end function updateState
!> @brief derive average stress and stiffness from constituent quantities
!--------------------------------------------------------------------------------------------------
subroutine averageStressAndItsTangent(ip,el)
use mesh, only: &
mesh_element
use material, only: &
homogenization_type, &
homogenization_typeInstance, &
homogenization_Ngrains, &
HOMOGENIZATION_NONE_ID, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_RGC_ID
use crystallite, only: &
crystallite_P,crystallite_dPdF
use homogenization_mech_RGC, only: &
homogenization_RGC_averageStressAndItsTangent
implicit none
integer, intent(in) :: &
ip, & !< integration point
el !< element number
@ -866,7 +733,7 @@ subroutine averageStressAndItsTangent(ip,el)
homogenization_typeInstance(mesh_element(3,el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call homogenization_RGC_averageStressAndItsTangent(&
call mech_RGC_averageStressAndItsTangent(&
materialpoint_P(1:3,1:3,ip,el), &
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
@ -882,41 +749,7 @@ end subroutine averageStressAndItsTangent
!> if homogenization_sizePostResults(i,e) > 0 !!
!--------------------------------------------------------------------------------------------------
function postResults(ip,el)
use mesh, only: &
mesh_element
use material, only: &
thermalMapping, &
thermal_typeInstance, &
material_homogenizationAt, &
homogenization_typeInstance,&
mappingHomogenization, &
homogState, &
thermalState, &
damageState, &
homogenization_type, &
thermal_type, &
damage_type, &
HOMOGENIZATION_NONE_ID, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_RGC_ID, &
THERMAL_isothermal_ID, &
THERMAL_adiabatic_ID, &
THERMAL_conduction_ID, &
DAMAGE_none_ID, &
DAMAGE_local_ID, &
DAMAGE_nonlocal_ID
use homogenization_mech_RGC, only: &
homogenization_RGC_postResults
use thermal_adiabatic, only: &
thermal_adiabatic_postResults
use thermal_conduction, only: &
thermal_conduction_postResults
use damage_local, only: &
damage_local_postResults
use damage_nonlocal, only: &
damage_nonlocal_postResults
implicit none
integer, intent(in) :: &
ip, & !< integration point
el !< element number
@ -926,23 +759,12 @@ function postResults(ip,el)
postResults
integer :: &
startPos, endPos ,&
of, instance, homog
homog
postResults = 0.0_pReal
startPos = 1
endPos = homogState(material_homogenizationAt(el))%sizePostResults
chosenHomogenization: select case (homogenization_type(mesh_element(3,el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
instance = homogenization_typeInstance(material_homogenizationAt(el))
of = mappingHomogenization(1,ip,el)
postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of)
end select chosenHomogenization
startPos = endPos + 1
endPos = endPos + thermalState(material_homogenizationAt(el))%sizePostResults
endPos = thermalState(material_homogenizationAt(el))%sizePostResults
chosenThermal: select case (thermal_type(mesh_element(3,el)))
case (THERMAL_adiabatic_ID) chosenThermal
@ -969,4 +791,36 @@ function postResults(ip,el)
end function postResults
!--------------------------------------------------------------------------------------------------
!> @brief writes homogenization results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_results
#if defined(PETSc) || defined(DAMASK_HDF5)
use config, only: &
config_name_homogenization => homogenization_name ! anticipate logical name
use material, only: &
material_homogenization_type => homogenization_type
integer :: p
character(len=256) :: group
do p=1,size(config_name_homogenization)
group = trim('current/materialpoint')//'/'//trim(config_name_homogenization(p))
call HDF5_closeGroup(results_addGroup(group))
group = trim(group)//'/mech'
call HDF5_closeGroup(results_addGroup(group))
select case(material_homogenization_type(p))
case(HOMOGENIZATION_rgc_ID)
call mech_RGC_results(homogenization_typeInstance(p),group)
end select
enddo
#endif
end subroutine homogenization_results
end module homogenization

260
src/homogenization_mech_RGC.f90
View File

@ -6,16 +6,7 @@
!> @brief Relaxed grain cluster (RGC) homogenization scheme
!> Nconstituents is defined as p x q x r (cluster)
!--------------------------------------------------------------------------------------------------
module homogenization_mech_RGC
use prec, only: &
pReal
implicit none
private
integer, dimension(:,:), allocatable,target, public :: &
homogenization_RGC_sizePostResult
character(len=64), dimension(:,:), allocatable,target, public :: &
homogenization_RGC_output ! name of each post result output
submodule(homogenization) homogenization_mech_RGC
enum, bind(c)
enumerator :: &
@ -28,7 +19,7 @@ module homogenization_mech_RGC
magnitudemismatch_ID
end enum
type, private :: tParameters
type :: tParameters
integer, dimension(:), allocatable :: &
Nconstituents
real(pReal) :: &
@ -43,7 +34,7 @@ module homogenization_mech_RGC
outputID
end type tParameters
type, private :: tRGCstate
type :: tRGCstate
real(pReal), pointer, dimension(:) :: &
work, &
penaltyEnergy
@ -51,7 +42,7 @@ module homogenization_mech_RGC
relaxationVector
end type tRGCstate
type, private :: tRGCdependentState
type :: tRGCdependentState
real(pReal), allocatable, dimension(:) :: &
volumeDiscrepancy, &
relaxationRate_avg, &
@ -62,68 +53,25 @@ module homogenization_mech_RGC
orientation
end type tRGCdependentState
type(tparameters), dimension(:), allocatable, private :: &
type(tparameters), dimension(:), allocatable :: &
param
type(tRGCstate), dimension(:), allocatable, private :: &
type(tRGCstate), dimension(:), allocatable :: &
state, &
state0
type(tRGCdependentState), dimension(:), allocatable, private :: &
type(tRGCdependentState), dimension(:), allocatable :: &
dependentState
public :: &
homogenization_RGC_init, &
homogenization_RGC_partitionDeformation, &
homogenization_RGC_averageStressAndItsTangent, &
homogenization_RGC_updateState, &
homogenization_RGC_postResults
private :: &
relaxationVector, &
interfaceNormal, &
getInterface, &
grain1to3, &
grain3to1, &
interface4to1, &
interface1to4
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_RGC_init()
use debug, only: &
#ifdef DEBUG
debug_i, &
debug_e, &
#endif
debug_level, &
debug_homogenization, &
debug_levelBasic
use math, only: &
math_EulerToR, &
INRAD
use IO, only: &
IO_error
use material, only: &
#ifdef DEBUG
mappingHomogenization, &
#endif
homogenization_type, &
material_homogenizationAt, &
homogState, &
HOMOGENIZATION_RGC_ID, &
HOMOGENIZATION_RGC_LABEL, &
homogenization_typeInstance, &
homogenization_Noutput, &
homogenization_Ngrains
use config, only: &
config_homogenization
module subroutine mech_RGC_init
implicit none
integer :: &
Ninstance, &
h, i, &
NofMyHomog, outputSize, &
NofMyHomog, &
sizeState, nIntFaceTot
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
@ -151,9 +99,6 @@ subroutine homogenization_RGC_init()
allocate(state0(Ninstance))
allocate(dependentState(Ninstance))
allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),Ninstance),source=0)
allocate(homogenization_RGC_output(maxval(homogenization_Noutput),Ninstance))
homogenization_RGC_output=''
do h = 1, size(homogenization_type)
if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle
@ -188,28 +133,20 @@ subroutine homogenization_RGC_init()
case('constitutivework')
outputID = constitutivework_ID
outputSize = 1
case('penaltyenergy')
outputID = penaltyenergy_ID
outputSize = 1
case('volumediscrepancy')
outputID = volumediscrepancy_ID
outputSize = 1
case('averagerelaxrate')
outputID = averagerelaxrate_ID
outputSize = 1
case('maximumrelaxrate')
outputID = maximumrelaxrate_ID
outputSize = 1
case('magnitudemismatch')
outputID = magnitudemismatch_ID
outputSize = 3
end select
if (outputID /= undefined_ID) then
homogenization_RGC_output(i,homogenization_typeInstance(h)) = outputs(i)
homogenization_RGC_sizePostResult(i,homogenization_typeInstance(h)) = outputSize
prm%outputID = [prm%outputID , outputID]
endif
@ -223,7 +160,7 @@ subroutine homogenization_RGC_init()
+ size(['avg constitutive work ','average penalty energy'])
homogState(h)%sizeState = sizeState
homogState(h)%sizePostResults = sum(homogenization_RGC_sizePostResult(:,homogenization_typeInstance(h)))
homogState(h)%sizePostResults = 0
allocate(homogState(h)%state0 (sizeState,NofMyHomog), source=0.0_pReal)
allocate(homogState(h)%subState0(sizeState,NofMyHomog), source=0.0_pReal)
allocate(homogState(h)%state (sizeState,NofMyHomog), source=0.0_pReal)
@ -247,24 +184,17 @@ subroutine homogenization_RGC_init()
enddo
end subroutine homogenization_RGC_init
end subroutine mech_RGC_init
!--------------------------------------------------------------------------------------------------
!> @brief partitions the deformation gradient onto the constituents
!--------------------------------------------------------------------------------------------------
subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of)
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_homogenization, &
debug_levelExtensive
#endif
module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
implicit none
real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain
real(pReal), dimension (:,:), intent(in) :: avgF !< averaged F
real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F
integer, intent(in) :: &
instance, &
of
@ -304,53 +234,14 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of)
end associate
end subroutine homogenization_RGC_partitionDeformation
end subroutine mech_RGC_partitionDeformation
!--------------------------------------------------------------------------------------------------
!> @brief update the internal state of the homogenization scheme and tell whether "done" and
! "happy" with result
!--------------------------------------------------------------------------------------------------
function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
use prec, only: &
dEq0
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_homogenization,&
debug_levelExtensive
#endif
use math, only: &
math_invert2
use material, only: &
material_homogenizationAt, &
homogenization_typeInstance, &
mappingHomogenization
use numerics, only: &
absTol_RGC, &
relTol_RGC, &
absMax_RGC, &
relMax_RGC, &
pPert_RGC, &
maxdRelax_RGC, &
viscPower_RGC, &
viscModus_RGC, &
refRelaxRate_RGC
implicit none
real(pReal), dimension(:,:,:), intent(in) :: &
P,& !< array of P
F,& !< array of F
F0 !< array of initial F
real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< array of current grain stiffness
real(pReal), dimension(3,3), intent(in) :: avgF !< average F
real(pReal), intent(in) :: dt !< time increment
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
logical, dimension(2) :: homogenization_RGC_updateState
module procedure mech_RGC_updateState
integer, dimension(4) :: intFaceN,intFaceP,faceID
integer, dimension(3) :: nGDim,iGr3N,iGr3P
@ -368,7 +259,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
#endif
zeroTimeStep: if(dEq0(dt)) then
homogenization_RGC_updateState = .true. ! pretend everything is fine and return
mech_RGC_updateState = .true. ! pretend everything is fine and return
return
endif zeroTimeStep
@ -487,12 +378,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
endif
#endif
homogenization_RGC_updateState = .false.
mech_RGC_updateState = .false.
!--------------------------------------------------------------------------------------------------
! If convergence reached => done and happy
if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then
homogenization_RGC_updateState = .true.
mech_RGC_updateState = .true.
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 &
.and. prm%of_debug == of) write(6,'(1x,a55,/)')'... done and happy'
@ -534,7 +425,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
!--------------------------------------------------------------------------------------------------
! if residual blows-up => done but unhappy
elseif (residMax > relMax_RGC*stresMax .or. residMax > absMax_RGC) then ! try to restart when residual blows up exceeding maximum bound
homogenization_RGC_updateState = [.true.,.false.] ! with direct cut-back
mech_RGC_updateState = [.true.,.false.] ! with direct cut-back
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 &
@ -677,9 +568,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
!--------------------------------------------------------------------------------------------------
! ... of the numerical viscosity traction "rmatrix"
allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
forall (i=1:3*nIntFaceTot) &
do i=1,3*nIntFaceTot
rmatrix(i,i) = viscModus_RGC*viscPower_RGC/(refRelaxRate_RGC*dt)* & ! tangent due to numerical viscosity traction appears
(abs(drelax(i))/(refRelaxRate_RGC*dt))**(viscPower_RGC - 1.0_pReal) ! only in the main diagonal term
enddo
#ifdef DEBUG
if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then
@ -731,7 +623,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
enddo; enddo
stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration
if (any(abs(drelax) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large
homogenization_RGC_updateState = [.true.,.false.]
mech_RGC_updateState = [.true.,.false.]
!$OMP CRITICAL (write2out)
write(6,'(1x,a,1x,i3,1x,a,1x,i3,1x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback'
write(6,'(1x,a,1x,e15.8)')'due to large relaxation change =',maxval(abs(drelax))
@ -757,12 +649,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
!> @brief calculate stress-like penalty due to deformation mismatch
!--------------------------------------------------------------------------------------------------
subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of)
use math, only: &
math_civita
use numerics, only: &
xSmoo_RGC
implicit none
real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty
real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch
@ -874,15 +761,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
!> @brief calculate stress-like penalty due to volume discrepancy
!--------------------------------------------------------------------------------------------------
subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of)
use math, only: &
math_det33, &
math_inv33
use numerics, only: &
maxVolDiscr_RGC,&
volDiscrMod_RGC,&
volDiscrPow_RGC
implicit none
real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume
real(pReal), intent(out) :: vDiscrep ! total volume discrepancy
@ -930,10 +809,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
! deformation
!--------------------------------------------------------------------------------------------------
function surfaceCorrection(avgF,instance,of)
use math, only: &
math_invert33
implicit none
real(pReal), dimension(3) :: surfaceCorrection
real(pReal), dimension(3,3), intent(in) :: avgF !< average F
@ -964,10 +840,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
!> @brief compute the equivalent shear and bulk moduli from the elasticity tensor
!--------------------------------------------------------------------------------------------------
function equivalentModuli(grainID,ip,el)
use constitutive, only: &
constitutive_homogenizedC
implicit none
real(pReal), dimension(2) :: equivalentModuli
integer, intent(in) :: &
@ -1003,7 +876,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
!--------------------------------------------------------------------------------------------------
subroutine grainDeformation(F, avgF, instance, of)
implicit none
real(pReal), dimension(:,:,:), intent(out) :: F !< partioned F per grain
real(pReal), dimension(:,:), intent(in) :: avgF !< averaged F
@ -1038,15 +910,14 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
end subroutine grainDeformation
end function homogenization_RGC_updateState
end procedure mech_RGC_updateState
!--------------------------------------------------------------------------------------------------
!> @brief derive average stress and stiffness from constituent quantities
!--------------------------------------------------------------------------------------------------
subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
implicit none
real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point
real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point
@ -1057,56 +928,54 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,
avgP = sum(P,3) /real(product(param(instance)%Nconstituents),pReal)
dAvgPdAvgF = sum(dPdF,5)/real(product(param(instance)%Nconstituents),pReal)
end subroutine homogenization_RGC_averageStressAndItsTangent
end subroutine mech_RGC_averageStressAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of homogenization results for post file inclusion
!> @brief writes results to HDF5 output file
! ToDo: check wheter units are correct
!--------------------------------------------------------------------------------------------------
pure function homogenization_RGC_postResults(instance,of) result(postResults)
module subroutine mech_RGC_results(instance,group)
#if defined(PETSc) || defined(DAMASK_HDF5)
implicit none
integer, intent(in) :: &
instance, &
of
integer, intent(in) :: instance
character(len=*), intent(in) :: group
integer :: &
o,c
real(pReal), dimension(sum(homogenization_RGC_sizePostResult(:,instance))) :: &
postResults
integer :: o
associate(stt => state(instance), dst => dependentState(instance), prm => param(instance))
c = 0
outputsLoop: do o = 1,size(prm%outputID)
select case(prm%outputID(o))
case (constitutivework_ID)
postResults(c+1) = stt%work(of)
c = c + 1
call results_writeDataset(group,stt%work,'W',&
'work density','J/m³')
case (magnitudemismatch_ID)
postResults(c+1:c+3) = dst%mismatch(1:3,of)
c = c + 3
call results_writeDataset(group,dst%mismatch,'N',&
'average mismatch tensor','1')
case (penaltyenergy_ID)
postResults(c+1) = stt%penaltyEnergy(of)
c = c + 1
call results_writeDataset(group,stt%penaltyEnergy,'R',&
'mismatch penalty density','J/m³')
case (volumediscrepancy_ID)
postResults(c+1) = dst%volumeDiscrepancy(of)
c = c + 1
case (averagerelaxrate_ID)
postResults(c+1) = dst%relaxationrate_avg(of)
c = c + 1
call results_writeDataset(group,dst%volumeDiscrepancy,'Delta_V',&
'volume discrepancy','m³')
case (maximumrelaxrate_ID)
postResults(c+1) = dst%relaxationrate_max(of)
c = c + 1
call results_writeDataset(group,dst%relaxationrate_max,'max_alpha_dot',&
'maximum relaxation rate','m/s')
case (averagerelaxrate_ID)
call results_writeDataset(group,dst%relaxationrate_avg,'avg_alpha_dot',&
'average relaxation rate','m/s')
end select
enddo outputsLoop
end associate
end function homogenization_RGC_postResults
#else
integer, intent(in) :: instance
character(len=*), intent(in) :: group
#endif
end subroutine mech_RGC_results
!--------------------------------------------------------------------------------------------------
@ -1114,7 +983,6 @@ end function homogenization_RGC_postResults
!--------------------------------------------------------------------------------------------------
pure function relaxationVector(intFace,instance,of)
implicit none
real(pReal), dimension (3) :: relaxationVector
integer, intent(in) :: instance,of
@ -1142,7 +1010,6 @@ end function relaxationVector
!--------------------------------------------------------------------------------------------------
pure function interfaceNormal(intFace,instance,of)
implicit none
real(pReal), dimension(3) :: interfaceNormal
integer, dimension(4), intent(in) :: intFace !< interface ID in 4D array (normal and position)
@ -1168,7 +1035,6 @@ end function interfaceNormal
!--------------------------------------------------------------------------------------------------
pure function getInterface(iFace,iGrain3)
implicit none
integer, dimension(4) :: getInterface
integer, dimension(3), intent(in) :: iGrain3 !< grain ID in 3D array
@ -1193,7 +1059,6 @@ end function getInterface
!--------------------------------------------------------------------------------------------------
pure function grain1to3(grain1,nGDim)
implicit none
integer, dimension(3) :: grain1to3
integer, intent(in) :: grain1 !< grain ID in 1D array
@ -1211,7 +1076,6 @@ end function grain1to3
!--------------------------------------------------------------------------------------------------
integer pure function grain3to1(grain3,nGDim)
implicit none
integer, dimension(3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z)
integer, dimension(3), intent(in) :: nGDim
@ -1227,7 +1091,6 @@ end function grain3to1
!--------------------------------------------------------------------------------------------------
integer pure function interface4to1(iFace4D, nGDim)
implicit none
integer, dimension(4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z)
integer, dimension(3), intent(in) :: nGDim
@ -1248,7 +1111,7 @@ integer pure function interface4to1(iFace4D, nGDim)
else
interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1) &
+ nGDim(3)*nGDim(1)*(iFace4D(3)-1) &
+ (nGDim(1)-1)*nGDim(2)*nGDim(3) ! total number of interfaces normal //e1
+ (nGDim(1)-1)*nGDim(2)*nGDim(3) ! total # of interfaces normal || e1
endif
case(3)
@ -1257,8 +1120,8 @@ integer pure function interface4to1(iFace4D, nGDim)
else
interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1) &
+ nGDim(1)*nGDim(2)*(iFace4D(4)-1) &
+ (nGDim(1)-1)*nGDim(2)*nGDim(3) & ! total number of interfaces normal //e1
+ nGDim(1)*(nGDim(2)-1)*nGDim(3) ! total number of interfaces normal //e2
+ (nGDim(1)-1)*nGDim(2)*nGDim(3) & ! total # of interfaces normal || e1
+ nGDim(1)*(nGDim(2)-1)*nGDim(3) ! total # of interfaces normal || e2
endif
case default
@ -1274,7 +1137,6 @@ end function interface4to1
!--------------------------------------------------------------------------------------------------
pure function interface1to4(iFace1D, nGDim)
implicit none
integer, dimension(4) :: interface1to4
integer, intent(in) :: iFace1D !< interface ID in 1D array
@ -1283,23 +1145,23 @@ pure function interface1to4(iFace1D, nGDim)
!--------------------------------------------------------------------------------------------------
! compute the total number of interfaces, which ...
nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), & ! ... normal //e1
nGDim(1)*(nGDim(2)-1)*nGDim(3), & ! ... normal //e2
nGDim(1)*nGDim(2)*(nGDim(3)-1)] ! ... normal //e3
nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), & ! ... normal || e1
nGDim(1)*(nGDim(2)-1)*nGDim(3), & ! ... normal || e2
nGDim(1)*nGDim(2)*(nGDim(3)-1)] ! ... normal || e3
!--------------------------------------------------------------------------------------------------
! get the corresponding interface ID in 4D (normal and local position)
if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal //e1
if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal || e1
interface1to4(1) = 1
interface1to4(3) = mod((iFace1D-1),nGDim(2))+1
interface1to4(4) = mod(int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)),nGDim(3))+1
interface1to4(2) = int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)/real(nGDim(3),pReal))+1
elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal //e2
elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal || e2
interface1to4(1) = 2
interface1to4(4) = mod((iFace1D-nIntFace(1)-1),nGDim(3))+1
interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)),nGDim(1))+1
interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)/real(nGDim(1),pReal))+1
elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal //e3
elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal || e3
interface1to4(1) = 3
interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1),nGDim(1))+1
interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)),nGDim(2))+1
@ -1309,4 +1171,4 @@ pure function interface1to4(iFace1D, nGDim)
end function interface1to4
end module homogenization_mech_RGC
end submodule homogenization_mech_RGC

20
src/homogenization_mech_isostrain.f90
View File

@ -6,8 +6,6 @@
!--------------------------------------------------------------------------------------------------
submodule(homogenization) homogenization_mech_isostrain
implicit none
enum, bind(c)
enumerator :: &
parallel_ID, &
@ -30,23 +28,7 @@ contains
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
module subroutine mech_isostrain_init
use debug, only: &
debug_HOMOGENIZATION, &
debug_level, &
debug_levelBasic
use IO, only: &
IO_error
use material, only: &
homogenization_type, &
material_homogenizationAt, &
homogState, &
HOMOGENIZATION_ISOSTRAIN_ID, &
HOMOGENIZATION_ISOSTRAIN_LABEL, &
homogenization_typeInstance
use config, only: &
config_homogenization
implicit none
integer :: &
Ninstance, &
h, &
@ -98,7 +80,6 @@ end subroutine mech_isostrain_init
!--------------------------------------------------------------------------------------------------
module subroutine mech_isostrain_partitionDeformation(F,avgF)
implicit none
real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
@ -113,7 +94,6 @@ end subroutine mech_isostrain_partitionDeformation
!--------------------------------------------------------------------------------------------------
module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
implicit none
real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point
real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point

15
src/homogenization_mech_none.f90
View File

@ -6,28 +6,13 @@
!--------------------------------------------------------------------------------------------------
submodule(homogenization) homogenization_mech_none
implicit none
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
module subroutine mech_none_init
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, &

103
src/kinematics_cleavage_opening.f90
View File

@ -5,18 +5,23 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_cleavage_opening
use prec, only: &
pReal, &
pInt
use prec
use IO
use config
use debug
use math
use lattice
use material
implicit none
private
integer(pInt), dimension(:), allocatable, private :: kinematics_cleavage_opening_instance
type, private :: tParameters !< container type for internal constitutive parameters
integer(pInt) :: &
integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance
type :: tParameters !< container type for internal constitutive parameters
integer :: &
totalNcleavage
integer(pInt), dimension(:), allocatable :: &
integer, dimension(:), allocatable :: &
Ncleavage !< active number of cleavage systems per family
real(pReal) :: &
sdot0, &
@ -27,17 +32,17 @@ module kinematics_cleavage_opening
end type
! Begin Deprecated
integer(pInt), dimension(:), allocatable, private :: &
integer, dimension(:), allocatable :: &
kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems
integer(pInt), dimension(:,:), allocatable, private :: &
integer, dimension(:,:), allocatable :: &
kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family
real(pReal), dimension(:), allocatable, private :: &
real(pReal), dimension(:), allocatable :: &
kinematics_cleavage_opening_sdot_0, &
kinematics_cleavage_opening_N
real(pReal), dimension(:,:), allocatable, private :: &
real(pReal), dimension(:,:), allocatable :: &
kinematics_cleavage_opening_critDisp, &
kinematics_cleavage_opening_critLoad
! End Deprecated
@ -53,50 +58,34 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_cleavage_opening_init()
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use config, only: &
config_phase
use IO, only: &
IO_error
use material, only: &
phase_kinematics, &
KINEMATICS_cleavage_opening_label, &
KINEMATICS_cleavage_opening_ID
use lattice, only: &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
subroutine kinematics_cleavage_opening_init
implicit none
integer(pInt), allocatable, dimension(:) :: tempInt
integer, allocatable, dimension(:) :: tempInt
real(pReal), allocatable, dimension(:) :: tempFloat
integer(pInt) :: maxNinstance,p,instance,kinematics
integer :: maxNinstance,p,instance
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>'
maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt)
if (maxNinstance == 0_pInt) return
maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID)
if (maxNinstance == 0) 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:',maxNinstance
allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0_pInt)
do p = 1_pInt, size(config_phase)
allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0)
do p = 1, size(config_phase)
kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct?
enddo
allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0)
allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0)
allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal)
do p = 1_pInt, size(config_phase)
do p = 1, size(config_phase)
if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle
instance = kinematics_cleavage_opening_instance(p)
kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0')
@ -115,13 +104,13 @@ subroutine kinematics_cleavage_opening_init()
kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance))
kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether
if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')')
call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')')
if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')')
call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')')
if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')')
call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')')
if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')')
call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')')
enddo
end subroutine kinematics_cleavage_opening_init
@ -130,22 +119,8 @@ end subroutine kinematics_cleavage_opening_init
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
use prec, only: &
tol_math_check
use math, only: &
math_mul33xx33
use material, only: &
material_phase, &
material_homogenizationAt, &
damage, &
damageMapping
use lattice, only: &
lattice_Scleavage, &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
@ -155,7 +130,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i
Ld !< damage velocity gradient
real(pReal), intent(out), dimension(3,3,3,3) :: &
dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor)
integer(pInt) :: &
integer :: &
instance, phase, &
homog, damageOffset, &
f, i, index_myFamily, k, l, m, n
@ -170,9 +145,9 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i
Ld = 0.0_pReal
dLd_dTstar = 0.0_pReal
do f = 1_pInt,lattice_maxNcleavageFamily
index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family
do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family
do f = 1,lattice_maxNcleavageFamily
index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family
do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family
traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase))
@ -186,7 +161,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i
Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)
dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ &
max(0.0_pReal, abs(traction_d) - traction_crit)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* &
lattice_Scleavage(m,n,1,index_myFamily+i,phase)
@ -200,7 +175,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i
Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)
dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ &
max(0.0_pReal, abs(traction_t) - traction_crit)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* &
lattice_Scleavage(m,n,2,index_myFamily+i,phase)
@ -214,7 +189,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i
Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)
dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ &
max(0.0_pReal, abs(traction_n) - traction_crit)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* &
lattice_Scleavage(m,n,3,index_myFamily+i,phase)

76
src/kinematics_slipplane_opening.f90
View File

@ -5,18 +5,23 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_slipplane_opening
use prec, only: &
pReal, &
pInt
use prec
use config
use IO
use debug
use math
use lattice
use material
implicit none
private
integer(pInt), dimension(:), allocatable, private :: kinematics_slipplane_opening_instance
type, private :: tParameters !< container type for internal constitutive parameters
integer(pInt) :: &
integer, dimension(:), allocatable :: kinematics_slipplane_opening_instance
type :: tParameters !< container type for internal constitutive parameters
integer :: &
totalNslip
integer(pInt), dimension(:), allocatable :: &
integer, dimension(:), allocatable :: &
Nslip !< active number of slip systems per family
real(pReal) :: &
sdot0, &
@ -29,7 +34,8 @@ module kinematics_slipplane_opening
slip_transverse
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
public :: &
kinematics_slipplane_opening_init, &
kinematics_slipplane_opening_LiAndItsTangent
@ -41,43 +47,26 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_slipplane_opening_init()
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use config, only: &
config_phase
use IO, only: &
IO_error
use math, only: &
math_expand
use material, only: &
phase_kinematics, &
KINEMATICS_slipplane_opening_label, &
KINEMATICS_slipplane_opening_ID
use lattice
subroutine kinematics_slipplane_opening_init
implicit none
integer(pInt) :: maxNinstance,p,instance,kinematics
integer :: maxNinstance,p,instance
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>'
maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID)
if (maxNinstance == 0) 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:',maxNinstance
allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0_pInt)
do p = 1_pInt, size(config_phase)
allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0)
do p = 1, size(config_phase)
kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct?
enddo
allocate(param(maxNinstance))
do p = 1_pInt, size(config_phase)
do p = 1, 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))
@ -91,7 +80,7 @@ subroutine kinematics_slipplane_opening_init()
prm%critLoad = math_expand(prm%critLoad, prm%Nslip)
prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),&
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))
@ -99,11 +88,11 @@ prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('latti
config%getFloat('c/a',defaultVal=0.0_pReal))
! 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//')')
! call IO_error(211,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//')')
! call IO_error(211,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//')')
! call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')')
end associate
enddo
@ -114,18 +103,7 @@ end subroutine kinematics_slipplane_opening_init
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
use prec, only: &
tol_math_check
use math, only: &
math_mul33xx33, &
math_outer
use material, only: &
material_phase, &
material_homogenizationAt, &
damage, &
damageMapping
implicit none
integer, intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
@ -173,7 +151,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
if (abs(udotd) > tol_math_check) then
Ld = Ld + udotd*projection_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) &
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotd_dt*projection_d(k,l)*projection_d(m,n)
endif
@ -185,7 +163,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
if (abs(udott) > tol_math_check) then
Ld = Ld + udott*projection_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) &
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudott_dt*projection_t(k,l)*projection_t(m,n)
endif
@ -197,7 +175,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
if (abs(udotn) > tol_math_check) then
Ld = Ld + udotn*projection_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) &
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotn_dt*projection_n(k,l)*projection_n(m,n)
endif

55
src/kinematics_thermal_expansion.f90
View File

@ -4,14 +4,18 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module kinematics_thermal_expansion
use prec, only: &
pReal, &
pInt
use prec
use IO
use config
use debug
use math
use lattice
use material
implicit none
private
type, private :: tParameters
type :: tParameters
real(pReal), allocatable, dimension(:,:,:) :: &
expansion
end type tParameters
@ -30,20 +34,9 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_thermal_expansion_init()
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use material, only: &
phase_kinematics, &
KINEMATICS_thermal_expansion_label, &
KINEMATICS_thermal_expansion_ID
use config, only: &
config_phase
subroutine kinematics_thermal_expansion_init
implicit none
integer(pInt) :: &
integer :: &
Ninstance, &
p, i
real(pReal), dimension(:), allocatable :: &
@ -51,14 +44,14 @@ subroutine kinematics_thermal_expansion_init()
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'
Ninstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt)
Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID)
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(param(Ninstance))
do p = 1_pInt, size(phase_kinematics)
do p = 1, size(phase_kinematics)
if (all(phase_kinematics(:,p) /= KINEMATICS_thermal_expansion_ID)) cycle
! ToDo: Here we need to decide how to extend the concept of instances to
@ -81,14 +74,8 @@ end subroutine kinematics_thermal_expansion_init
!> @brief report initial thermal strain based on current temperature deviation from reference
!--------------------------------------------------------------------------------------------------
pure function kinematics_thermal_expansion_initialStrain(homog,phase,offset)
use material, only: &
temperature
use lattice, only: &
lattice_thermalExpansion33, &
lattice_referenceTemperature
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
homog, offset
real(pReal), dimension(3,3) :: &
@ -110,18 +97,8 @@ end function kinematics_thermal_expansion_initialStrain
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el)
use material, only: &
material_phase, &
material_homogenizationAt, &
temperature, &
temperatureRate, &
thermalMapping
use lattice, only: &
lattice_thermalExpansion33, &
lattice_referenceTemperature
implicit none
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
@ -129,7 +106,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip,
Li !< thermal velocity gradient
real(pReal), intent(out), dimension(3,3,3,3) :: &
dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero)
integer(pInt) :: &
integer :: &
phase, &
homog, offset
real(pReal) :: &

200
src/lattice.f90
View File

@ -7,8 +7,10 @@
! and cleavage as well as interaction among the various systems
!--------------------------------------------------------------------------------------------------
module lattice
use prec, only: &
pReal
use prec
use IO
use config
use math
use future
implicit none
@ -28,25 +30,25 @@ module lattice
!--------------------------------------------------------------------------------------------------
! face centered cubic
integer, dimension(2), parameter, private :: &
integer, dimension(2), parameter :: &
LATTICE_FCC_NSLIPSYSTEM = [12, 6] !< # of slip systems per family for fcc
integer, dimension(1), parameter, private :: &
integer, dimension(1), parameter :: &
LATTICE_FCC_NTWINSYSTEM = [12] !< # of twin systems per family for fcc
integer, dimension(1), parameter, private :: &
integer, dimension(1), parameter :: &
LATTICE_FCC_NTRANSSYSTEM = [12] !< # of transformation systems per family for fcc
integer, dimension(2), parameter, private :: &
integer, dimension(2), parameter :: &
LATTICE_FCC_NCLEAVAGESYSTEM = [3, 4] !< # of cleavage systems per family for fcc
integer, parameter, private :: &
integer, parameter :: &
LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc
LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc
LATTICE_FCC_NTRANS = sum(LATTICE_FCC_NTRANSSYSTEM), & !< total # of transformation systems for fcc
LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc
real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter :: &
LATTICE_FCC_SYSTEMSLIP = reshape(real([&
! Slip direction Plane normal ! SCHMID-BOAS notation
0, 1,-1, 1, 1, 1, & ! B2
@ -70,11 +72,11 @@ module lattice
0, 1,-1, 0, 1, 1 &
],pReal),shape(LATTICE_FCC_SYSTEMSLIP)) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli
character(len=*), dimension(2), parameter, private :: LATTICE_FCC_SLIPFAMILY_NAME = &
character(len=*), dimension(2), parameter :: LATTICE_FCC_SLIPFAMILY_NAME = &
['<0 1 -1>{1 1 1}', &
'<0 1 -1>{0 1 1}']
real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter :: &
LATTICE_FCC_SYSTEMTWIN = reshape(real( [&
-2, 1, 1, 1, 1, 1, &
1,-2, 1, 1, 1, 1, &
@ -90,7 +92,7 @@ module lattice
-1, 1, 2, -1, 1,-1 &
],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli
character(len=*), dimension(1), parameter, private :: LATTICE_FCC_TWINFAMILY_NAME = &
character(len=*), dimension(1), parameter :: LATTICE_FCC_TWINFAMILY_NAME = &
['<-2 1 1>{1 1 1}']
@ -110,7 +112,7 @@ module lattice
10,11 &
],shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR))
real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter :: &
LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([&
! Cleavage direction Plane normal
0, 1, 0, 1, 0, 0, &
@ -124,21 +126,21 @@ module lattice
!--------------------------------------------------------------------------------------------------
! body centered cubic
integer, dimension(2), parameter, private :: &
integer, dimension(2), parameter :: &
LATTICE_BCC_NSLIPSYSTEM = [12, 12] !< # of slip systems per family for bcc
integer, dimension(1), parameter, private :: &
integer, dimension(1), parameter :: &
LATTICE_BCC_NTWINSYSTEM = [12] !< # of twin systems per family for bcc
integer, dimension(2), parameter, private :: &
integer, dimension(2), parameter :: &
LATTICE_BCC_NCLEAVAGESYSTEM = [3, 6] !< # of cleavage systems per family for bcc
integer, parameter, private :: &
integer, parameter :: &
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
real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter :: &
LATTICE_BCC_SYSTEMSLIP = reshape(real([&
! Slip direction Plane normal
! Slip system <111>{110}
@ -169,11 +171,11 @@ module lattice
1, 1, 1, 1, 1,-2 &
],pReal),shape(LATTICE_BCC_SYSTEMSLIP))
character(len=*), dimension(2), parameter, private :: LATTICE_BCC_SLIPFAMILY_NAME = &
character(len=*), dimension(2), parameter :: LATTICE_BCC_SLIPFAMILY_NAME = &
['<1 -1 1>{0 1 1}', &
'<1 -1 1>{2 1 1}']
real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter :: &
LATTICE_BCC_SYSTEMTWIN = reshape(real([&
! Twin system <111>{112}
-1, 1, 1, 2, 1, 1, &
@ -190,10 +192,10 @@ module lattice
1, 1, 1, 1, 1,-2 &
],pReal),shape(LATTICE_BCC_SYSTEMTWIN))
character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = &
character(len=*), dimension(1), parameter :: LATTICE_BCC_TWINFAMILY_NAME = &
['<1 1 1>{2 1 1}']
real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter :: &
LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([&
! Cleavage direction Plane normal
0, 1, 0, 1, 0, 0, &
@ -209,21 +211,21 @@ module lattice
!--------------------------------------------------------------------------------------------------
! hexagonal
integer, dimension(6), parameter, private :: &
integer, dimension(6), parameter :: &
LATTICE_HEX_NSLIPSYSTEM = [3, 3, 3, 6, 12, 6] !< # of slip systems per family for hex
integer, dimension(4), parameter, private :: &
integer, dimension(4), parameter :: &
LATTICE_HEX_NTWINSYSTEM = [6, 6, 6, 6] !< # of slip systems per family for hex
integer, dimension(1), parameter, private :: &
integer, dimension(1), parameter :: &
LATTICE_HEX_NCLEAVAGESYSTEM = [3] !< # of cleavage systems per family for hex
integer, parameter, private :: &
integer, parameter :: &
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
real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: &
real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter :: &
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))
@ -267,7 +269,7 @@ module lattice
1, 1, -2, 3, -1, -1, 2, 2 &
],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr
character(len=*), dimension(6), parameter, private :: LATTICE_HEX_SLIPFAMILY_NAME = &
character(len=*), dimension(6), parameter :: LATTICE_HEX_SLIPFAMILY_NAME = &
['<1 1 . 1>{0 0 . 1} ', &
'<1 1 . 1>{1 0 . 0} ', &
'<1 0 . 0>{1 1 . 0} ', &
@ -275,7 +277,7 @@ module lattice
'<1 1 . 3>{-1 0 . 1} ', &
'<1 1 . 3>{-1 -1 . 2}']
real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: &
real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter :: &
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)
@ -307,13 +309,13 @@ module lattice
1, 1, -2, -3, 1, 1, -2, 2 &
],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme
character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = &
character(len=*), dimension(4), parameter :: LATTICE_HEX_TWINFAMILY_NAME = &
['<-1 0 . 1>{1 0 . 2} ', &
'<1 1 . 6>{-1 -1 . 1}', &
'<1 0 . -2>{1 0 . 1} ', &
'<1 1 . -3>{1 1 . 2} ']
real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: &
real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter :: &
LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([&
! Cleavage direction Plane normal
2,-1,-1, 0, 0, 0, 0, 1, &
@ -324,13 +326,13 @@ module lattice
!--------------------------------------------------------------------------------------------------
! body centered tetragonal
integer, dimension(13), parameter, private :: &
integer, dimension(13), parameter :: &
LATTICE_BCT_NSLIPSYSTEM = [2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ] !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009
integer, parameter, private :: &
integer, parameter :: &
LATTICE_BCT_NSLIP = sum(LATTICE_BCT_NSLIPSYSTEM) !< total # of slip systems for bct
real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter :: &
LATTICE_BCT_SYSTEMSLIP = reshape(real([&
! Slip direction Plane normal
! Slip family 1 {100)<001] (Bravais notation {hkl)<uvw] for bct c/a = 0.5456)
@ -400,7 +402,7 @@ module lattice
1, 1, 1, 1,-2, 1 &
],pReal),[ 3 + 3,LATTICE_BCT_NSLIP]) !< slip systems for bct sorted by Bieler
character(len=*), dimension(13), parameter, private :: LATTICE_BCT_SLIPFAMILY_NAME = &
character(len=*), dimension(13), parameter :: LATTICE_BCT_SLIPFAMILY_NAME = &
['{1 0 0)<0 0 1] ', &
'{1 1 0)<0 0 1] ', &
'{1 0 0)<0 1 0] ', &
@ -418,13 +420,13 @@ module lattice
!--------------------------------------------------------------------------------------------------
! isotropic
integer, dimension(1), parameter, private :: &
integer, dimension(1), parameter :: &
LATTICE_ISO_NCLEAVAGESYSTEM = [3] !< # of cleavage systems per family for iso
integer, parameter, private :: &
integer, parameter :: &
LATTICE_ISO_NCLEAVAGE = sum(LATTICE_ISO_NCLEAVAGESYSTEM) !< total # of cleavage systems for iso
real(pReal), dimension(3+3,LATTICE_ISO_NCLEAVAGE), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_ISO_NCLEAVAGE), parameter :: &
LATTICE_ISO_SYSTEMCLEAVAGE= reshape(real([&
! Cleavage direction Plane normal
0, 1, 0, 1, 0, 0, &
@ -435,13 +437,13 @@ module lattice
!--------------------------------------------------------------------------------------------------
! orthorhombic
integer, dimension(3), parameter, private :: &
integer, dimension(3), parameter :: &
LATTICE_ORT_NCLEAVAGESYSTEM = [1, 1, 1] !< # of cleavage systems per family for ortho
integer, parameter, private :: &
integer, parameter :: &
LATTICE_ORT_NCLEAVAGE = sum(LATTICE_ORT_NCLEAVAGESYSTEM) !< total # of cleavage systems for ortho
real(pReal), dimension(3+3,LATTICE_ORT_NCLEAVAGE), parameter, private :: &
real(pReal), dimension(3+3,LATTICE_ORT_NCLEAVAGE), parameter :: &
LATTICE_ORT_SYSTEMCLEAVAGE = reshape(real([&
! Cleavage direction Plane normal
0, 1, 0, 1, 0, 0, &
@ -541,10 +543,6 @@ module lattice
!> @brief Module initialization
!--------------------------------------------------------------------------------------------------
subroutine lattice_init
use IO, only: &
IO_error
use config, only: &
config_phase
integer :: Nphases
character(len=65536) :: &
@ -654,14 +652,6 @@ end subroutine lattice_init
!> @brief !!!!!!!DEPRECTATED!!!!!!
!--------------------------------------------------------------------------------------------------
subroutine lattice_initializeStructure(myPhase,CoverA)
use prec, only: &
tol_math_check
use math, only: &
math_sym3333to66, &
math_Voigt66to3333, &
math_cross
use IO, only: &
IO_error
integer, intent(in) :: myPhase
real(pReal), intent(in) :: &
@ -690,9 +680,10 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
call IO_error(135,el=i,ip=myPhase,ext_msg='matrix diagonal "el"ement of phase "ip"')
enddo
forall (i = 1:3) &
do i = 1,3
lattice_thermalExpansion33 (1:3,1:3,i,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),&
lattice_thermalExpansion33 (1:3,1:3,i,myPhase))
enddo
lattice_thermalConductivity33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),&
lattice_thermalConductivity33 (1:3,1:3,myPhase))
@ -763,17 +754,17 @@ pure function lattice_symmetrizeC66(struct,C66)
select case(struct)
case (LATTICE_iso_ID)
forall(k=1:3)
do k=1,3
forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2)
lattice_symmetrizeC66(k,k) = C66(1,1)
lattice_symmetrizeC66(k+3,k+3) = 0.5_pReal*(C66(1,1)-C66(1,2))
end forall
enddo
case (LATTICE_fcc_ID,LATTICE_bcc_ID)
forall(k=1:3)
do k=1,3
forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2)
lattice_symmetrizeC66(k,k) = C66(1,1)
lattice_symmetrizeC66(k+3,k+3) = C66(4,4)
end forall
enddo
case (LATTICE_hex_ID)
lattice_symmetrizeC66(1,1) = C66(1,1)
lattice_symmetrizeC66(2,2) = C66(1,1)
@ -834,7 +825,9 @@ pure function lattice_symmetrize33(struct,T33)
select case(struct)
case (LATTICE_iso_ID,LATTICE_fcc_ID,LATTICE_bcc_ID)
forall(k=1:3) lattice_symmetrize33(k,k) = T33(1,1)
do k=1,3
lattice_symmetrize33(k,k) = T33(1,1)
enddo
case (LATTICE_hex_ID)
lattice_symmetrize33(1,1) = T33(1,1)
lattice_symmetrize33(2,2) = T33(1,1)
@ -854,10 +847,6 @@ end function lattice_symmetrize33
!> @brief figures whether unit quat falls into stereographic standard triangle
!--------------------------------------------------------------------------------------------------
logical pure function lattice_qInSST(Q, struct)
use, intrinsic :: &
IEEE_arithmetic
use math, only: &
math_qToRodrig
real(pReal), dimension(4), intent(in) :: Q ! orientation
integer(kind(LATTICE_undefined_ID)), intent(in) :: struct ! lattice structure
@ -888,11 +877,6 @@ end function lattice_qInSST
!> @brief calculates the disorientation for 2 unit quaternions
!--------------------------------------------------------------------------------------------------
pure function lattice_qDisorientation(Q1, Q2, struct)
use prec, only: &
tol_math_check
use math, only: &
math_qMul, &
math_qConj
real(pReal), dimension(4) :: lattice_qDisorientation
real(pReal), dimension(4), intent(in) :: &
@ -998,8 +982,6 @@ end function lattice_qDisorientation
!> @brief Characteristic shear for twinning
!--------------------------------------------------------------------------------------------------
function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(characteristicShear)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -1077,14 +1059,6 @@ end function lattice_characteristicShear_Twin
!> @brief Rotated elasticity matrices for twinning in 66-vector notation
!--------------------------------------------------------------------------------------------------
function lattice_C66_twin(Ntwin,C66,structure,CoverA)
use IO, only: &
IO_error
use math, only: &
PI, &
math_axisAngleToR, &
math_sym3333to66, &
math_66toSym3333, &
math_rotate_forward3333
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -1125,17 +1099,6 @@ end function lattice_C66_twin
!--------------------------------------------------------------------------------------------------
function lattice_C66_trans(Ntrans,C_parent66,structure_target, &
CoverA_trans,a_bcc,a_fcc)
use prec, only: &
tol_math_check
use IO, only: &
IO_error
use math, only: &
INRAD, &
MATH_I3, &
math_axisAngleToR, &
math_sym3333to66, &
math_66toSym3333, &
math_rotate_forward3333
integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family
character(len=*), intent(in) :: structure_target !< lattice structure
@ -1196,13 +1159,6 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, &
! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1
!--------------------------------------------------------------------------------------------------
function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix)
use IO, only: &
IO_error
use math, only: &
INRAD, &
math_outer, &
math_cross, &
math_axisAngleToR
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections
@ -1246,8 +1202,6 @@ end function lattice_nonSchmidMatrix
!> details only active slip systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipBySlip(Nslip,interactionValues,structure) result(interactionMatrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction
@ -1468,8 +1422,6 @@ end function lattice_interaction_SlipBySlip
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_TwinByTwin(Ntwin,interactionValues,structure) result(interactionMatrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction
@ -1571,8 +1523,6 @@ end function lattice_interaction_TwinByTwin
!> details only active trans systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_TransByTrans(Ntrans,interactionValues,structure) result(interactionMatrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family
real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction
@ -1618,8 +1568,6 @@ end function lattice_interaction_TransByTrans
!> details only active slip and twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family
Ntwin !< number of active twin systems per family
@ -1760,8 +1708,6 @@ end function lattice_interaction_SlipByTwin
!> details only active slip and trans systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family
Ntrans !< number of active trans systems per family
@ -1818,8 +1764,6 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structur
!> details only active twin and slip systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family
Nslip !< number of active slip systems per family
@ -1898,13 +1842,6 @@ end function lattice_interaction_TwinBySlip
!> details only active slip systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix)
use prec, only: &
tol_math_check
use IO, only: &
IO_error
use math, only: &
math_trace33, &
math_outer
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -1957,13 +1894,6 @@ end function lattice_SchmidMatrix_slip
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
use prec, only: &
tol_math_check
use IO, only: &
IO_error
use math, only: &
math_trace33, &
math_outer
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -2013,8 +1943,6 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family
real(pReal), intent(in) :: cOverA !< c/a ratio
@ -2041,10 +1969,6 @@ end function lattice_SchmidMatrix_trans
!> details only active cleavage systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix)
use math, only: &
math_outer
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -2154,8 +2078,6 @@ end function lattice_slip_transverse
!> @details: This projection is used to calculate forest hardening for edge dislocations
!--------------------------------------------------------------------------------------------------
function slipProjection_transverse(Nslip,structure,cOverA) result(projection)
use math, only: &
math_inner
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -2179,8 +2101,6 @@ end function slipProjection_transverse
!> @details: This projection is used to calculate forest hardening for screw dislocations
!--------------------------------------------------------------------------------------------------
function slipProjection_direction(Nslip,structure,cOverA) result(projection)
use math, only: &
math_inner
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -2204,8 +2124,6 @@ end function slipProjection_direction
!> @details Order: Direction, plane (normal), and common perpendicular
!--------------------------------------------------------------------------------------------------
function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: structure !< lattice structure
@ -2249,8 +2167,6 @@ end function coordinateSystem_slip
!> @brief Populates reduced interaction matrix
!--------------------------------------------------------------------------------------------------
function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,values,matrix)
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: &
reacting_used, & !< # of reacting systems per family as specified in material.config
@ -2295,10 +2211,6 @@ end function buildInteraction
!> @details Order: Direction, plane (normal), and common perpendicular
!--------------------------------------------------------------------------------------------------
function buildCoordinateSystem(active,complete,system,structure,cOverA)
use IO, only: &
IO_error
use math, only: &
math_cross
integer, dimension(:), intent(in) :: &
active, &
@ -2370,16 +2282,6 @@ end function buildCoordinateSystem
! set a_bcc = 0.0 for fcc -> hex transformation
!--------------------------------------------------------------------------------------------------
subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc)
use prec, only: &
dEq0
use math, only: &
math_cross, &
math_outer, &
math_axisAngleToR, &
INRAD, &
MATH_I3
use IO, only: &
IO_error
integer, dimension(:), intent(in) :: &
Ntrans

34
src/list.f90
View File

@ -3,8 +3,8 @@
!> @brief linked list
!--------------------------------------------------------------------------------------------------
module list
use prec, only: &
pReal
use prec
use IO
implicit none
private
@ -65,10 +65,6 @@ contains
!! to lower case. The data is not stored in the new element but in the current.
!--------------------------------------------------------------------------------------------------
subroutine add(this,string)
use IO, only: &
IO_isBlank, &
IO_lc, &
IO_stringPos
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: string
@ -157,8 +153,6 @@ end subroutine finalizeArray
!> @brief reports wether a given key (string value at first position) exists in the list
!--------------------------------------------------------------------------------------------------
logical function keyExists(this,key)
use IO, only: &
IO_stringValue
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
@ -180,8 +174,6 @@ end function keyExists
!> @details traverses list and counts each occurrence of specified key
!--------------------------------------------------------------------------------------------------
integer function countKeys(this,key)
use IO, only: &
IO_stringValue
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
@ -205,10 +197,6 @@ end function countKeys
!! error unless default is given
!--------------------------------------------------------------------------------------------------
real(pReal) function getFloat(this,key,defaultVal)
use IO, only : &
IO_error, &
IO_stringValue, &
IO_FloatValue
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
@ -241,10 +229,6 @@ end function getFloat
!! error unless default is given
!--------------------------------------------------------------------------------------------------
integer function getInt(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
@ -278,9 +262,6 @@ end function getInt
!! the individual chunks are returned
!--------------------------------------------------------------------------------------------------
character(len=65536) function getString(this,key,defaultVal,raw)
use IO, only: &
IO_error, &
IO_stringValue
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
@ -327,10 +308,6 @@ end function getString
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getFloats(this,key,defaultVal,requiredSize)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), target, intent(in) :: this
@ -376,10 +353,6 @@ end function getFloats
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getInts(this,key,defaultVal,requiredSize)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
integer, dimension(:), allocatable :: getInts
class(tPartitionedStringList), target, intent(in) :: this
@ -426,9 +399,6 @@ end function getInts
!! If raw is true, the the complete string is returned, otherwise the individual chunks are returned
!--------------------------------------------------------------------------------------------------
function getStrings(this,key,defaultVal,raw)
use IO, only: &
IO_error, &
IO_StringValue
character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList),target, intent(in) :: this

282
src/material.f90
View File

@ -47,55 +47,35 @@ module material
enum, bind(c)
enumerator :: ELASTICITY_undefined_ID, &
ELASTICITY_hooke_ID
end enum
enum, bind(c)
enumerator :: PLASTICITY_undefined_ID, &
ELASTICITY_hooke_ID, &
PLASTICITY_undefined_ID, &
PLASTICITY_none_ID, &
PLASTICITY_isotropic_ID, &
PLASTICITY_phenopowerlaw_ID, &
PLASTICITY_kinehardening_ID, &
PLASTICITY_dislotwin_ID, &
PLASTICITY_disloucla_ID, &
PLASTICITY_nonlocal_ID
end enum
enum, bind(c)
enumerator :: SOURCE_undefined_ID, &
PLASTICITY_nonlocal_ID, &
SOURCE_undefined_ID, &
SOURCE_thermal_dissipation_ID, &
SOURCE_thermal_externalheat_ID, &
SOURCE_damage_isoBrittle_ID, &
SOURCE_damage_isoDuctile_ID, &
SOURCE_damage_anisoBrittle_ID, &
SOURCE_damage_anisoDuctile_ID
end enum
enum, bind(c)
enumerator :: KINEMATICS_undefined_ID, &
SOURCE_damage_anisoDuctile_ID, &
KINEMATICS_undefined_ID, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_thermal_expansion_ID
end enum
enum, bind(c)
enumerator :: STIFFNESS_DEGRADATION_undefined_ID, &
STIFFNESS_DEGRADATION_damage_ID
end enum
enum, bind(c)
enumerator :: THERMAL_isothermal_ID, &
KINEMATICS_thermal_expansion_ID, &
STIFFNESS_DEGRADATION_undefined_ID, &
STIFFNESS_DEGRADATION_damage_ID, &
THERMAL_isothermal_ID, &
THERMAL_adiabatic_ID, &
THERMAL_conduction_ID
end enum
enum, bind(c)
enumerator :: DAMAGE_none_ID, &
THERMAL_conduction_ID, &
DAMAGE_none_ID, &
DAMAGE_local_ID, &
DAMAGE_nonlocal_ID
end enum
enum, bind(c)
enumerator :: HOMOGENIZATION_undefined_ID, &
DAMAGE_nonlocal_ID, &
HOMOGENIZATION_undefined_ID, &
HOMOGENIZATION_none_ID, &
HOMOGENIZATION_isostrain_ID, &
HOMOGENIZATION_rgc_ID
@ -118,10 +98,10 @@ module material
integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: &
homogenization_type !< type of each homogenization
integer(pInt), public, protected :: &
integer, public, protected :: &
homogenization_maxNgrains !< max number of grains in any USED homogenization
integer(pInt), dimension(:), allocatable, public, protected :: &
integer, dimension(:), allocatable, public, protected :: &
phase_Nsources, & !< number of source mechanisms active in each phase
phase_Nkinematics, & !< number of kinematic mechanisms active in each phase
phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase
@ -152,7 +132,7 @@ module material
! END NEW MAPPINGS
! DEPRECATED: use material_phaseAt
integer(pInt), dimension(:,:,:), allocatable, public :: &
integer, dimension(:,:,:), allocatable, public :: &
material_phase !< phase (index) of each grain,IP,element
type(tPlasticState), allocatable, dimension(:), public :: &
@ -164,7 +144,7 @@ module material
thermalState, &
damageState
integer(pInt), dimension(:,:,:), allocatable, public, protected :: &
integer, dimension(:,:,:), allocatable, public, protected :: &
material_texture !< texture (index) of each grain,IP,element
real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
@ -175,15 +155,15 @@ module material
microstructure_elemhomo, & !< flag to indicate homogeneous microstructure distribution over element's IPs
phase_localPlasticity !< flags phases with local constitutive law
integer(pInt), private :: &
integer, private :: &
microstructure_maxNconstituents, & !< max number of constituents in any phase
texture_maxNgauss !< max number of Gauss components in any texture
integer(pInt), dimension(:), allocatable, private :: &
integer, dimension(:), allocatable, private :: &
microstructure_Nconstituents, & !< number of constituents in each microstructure
texture_Ngauss !< number of Gauss components per texture
integer(pInt), dimension(:,:), allocatable, private :: &
integer, dimension(:,:), allocatable, private :: &
microstructure_phase, & !< phase IDs of each microstructure
microstructure_texture !< texture IDs of each microstructure
@ -198,11 +178,11 @@ module material
homogenization_active
! BEGIN DEPRECATED
integer(pInt), dimension(:,:,:), allocatable, public :: phaseAt !< phase ID of every material point (ipc,ip,el)
integer(pInt), dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el)
integer, dimension(:,:,:), allocatable, public :: phaseAt !< phase ID of every material point (ipc,ip,el)
integer, dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el)
integer(pInt), dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field
integer(pInt), dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field
integer, dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field
integer, dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field
! END DEPRECATED
type(tHomogMapping), allocatable, dimension(:), public :: &
@ -276,13 +256,13 @@ subroutine material_init
use mesh, only: &
theMesh
integer(pInt), parameter :: FILEUNIT = 210_pInt
integer(pInt) :: m,c,h, myDebug, myPhase, myHomog
integer(pInt) :: &
integer, parameter :: FILEUNIT = 210
integer :: m,c,h, myDebug, myPhase, myHomog
integer :: &
g, & !< grain number
i, & !< integration point number
e !< element number
integer(pInt), dimension(:), allocatable :: &
integer, dimension(:), allocatable :: &
CounterPhase, &
CounterHomogenization
@ -291,19 +271,19 @@ subroutine material_init
write(6,'(/,a)') ' <<<+- material init -+>>>'
call material_parsePhase()
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)
call material_parseMicrostructure()
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)
call material_parseCrystallite()
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)
call material_parseHomogenization()
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)
call material_parseTexture()
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)
allocate(plasticState (size(config_phase)))
allocate(sourceState (size(config_phase)))
@ -323,34 +303,34 @@ subroutine material_init
allocate(temperatureRate (size(config_homogenization)))
do m = 1_pInt,size(config_microstructure)
if(microstructure_crystallite(m) < 1_pInt .or. &
do m = 1,size(config_microstructure)
if(microstructure_crystallite(m) < 1 .or. &
microstructure_crystallite(m) > size(config_crystallite)) &
call IO_error(150_pInt,m,ext_msg='crystallite')
if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. &
call IO_error(150,m,ext_msg='crystallite')
if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1 .or. &
maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) &
call IO_error(150_pInt,m,ext_msg='phase')
if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. &
call IO_error(150,m,ext_msg='phase')
if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1 .or. &
maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(config_texture)) &
call IO_error(150_pInt,m,ext_msg='texture')
if(microstructure_Nconstituents(m) < 1_pInt) &
call IO_error(151_pInt,m)
call IO_error(150,m,ext_msg='texture')
if(microstructure_Nconstituents(m) < 1) &
call IO_error(151,m)
enddo
debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then
debugOut: if (iand(myDebug,debug_levelExtensive) /= 0) then
write(6,'(/,a,/)') ' MATERIAL configuration'
write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains'
do h = 1_pInt,size(config_homogenization)
do h = 1,size(config_homogenization)
write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h)
enddo
write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous'
do m = 1_pInt,size(config_microstructure)
do m = 1,size(config_microstructure)
write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), &
microstructure_crystallite(m), &
microstructure_Nconstituents(m), &
microstructure_elemhomo(m)
if (microstructure_Nconstituents(m) > 0_pInt) then
do c = 1_pInt,microstructure_Nconstituents(m)
if (microstructure_Nconstituents(m) > 0) then
do c = 1,microstructure_Nconstituents(m)
write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),&
texture_name(microstructure_texture(c,m)),&
microstructure_fraction(c,m)
@ -403,23 +383,23 @@ subroutine material_init
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN DEPRECATED
allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt)
allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0)
allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1)
CounterHomogenization=0
CounterPhase =0
do e = 1_pInt,theMesh%Nelems
do e = 1,theMesh%Nelems
myHomog = theMesh%homogenizationAt(e)
do i = 1_pInt, theMesh%elem%nIPs
CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt
do i = 1, theMesh%elem%nIPs
CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1
mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)]
do g = 1_pInt,homogenization_Ngrains(myHomog)
do g = 1,homogenization_Ngrains(myHomog)
myPhase = material_phase(g,i,e)
CounterPhase(myPhase) = CounterPhase(myPhase)+1_pInt ! not distinguishing between instances of same phase
CounterPhase(myPhase) = CounterPhase(myPhase)+1 ! not distinguishing between instances of same phase
phaseAt(g,i,e) = myPhase
phasememberAt(g,i,e) = CounterPhase(myPhase)
enddo
@ -449,33 +429,33 @@ subroutine material_parseHomogenization
use IO, only: &
IO_error
integer(pInt) :: h
integer :: h
character(len=65536) :: tag
allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID)
allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID)
allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID)
allocate(homogenization_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(thermal_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(damage_typeInstance(size(config_homogenization)), source=0_pInt)
allocate(homogenization_Ngrains(size(config_homogenization)), source=0_pInt)
allocate(homogenization_Noutput(size(config_homogenization)), source=0_pInt)
allocate(homogenization_typeInstance(size(config_homogenization)), source=0)
allocate(thermal_typeInstance(size(config_homogenization)), source=0)
allocate(damage_typeInstance(size(config_homogenization)), source=0)
allocate(homogenization_Ngrains(size(config_homogenization)), source=0)
allocate(homogenization_Noutput(size(config_homogenization)), source=0)
allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!!
allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal)
allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal)
forall (h = 1_pInt:size(config_homogenization)) &
forall (h = 1:size(config_homogenization)) &
homogenization_active(h) = any(theMesh%homogenizationAt == h)
do h=1_pInt, size(config_homogenization)
do h=1, size(config_homogenization)
homogenization_Noutput(h) = config_homogenization(h)%countKeys('(output)')
tag = config_homogenization(h)%getString('mech')
select case (trim(tag))
case(HOMOGENIZATION_NONE_label)
homogenization_type(h) = HOMOGENIZATION_NONE_ID
homogenization_Ngrains(h) = 1_pInt
homogenization_Ngrains(h) = 1
case(HOMOGENIZATION_ISOSTRAIN_label)
homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID
homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents')
@ -483,7 +463,7 @@ subroutine material_parseHomogenization
homogenization_type(h) = HOMOGENIZATION_RGC_ID
homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents')
case default
call IO_error(500_pInt,ext_msg=trim(tag))
call IO_error(500,ext_msg=trim(tag))
end select
homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h))
@ -500,7 +480,7 @@ subroutine material_parseHomogenization
case(THERMAL_conduction_label)
thermal_type(h) = THERMAL_conduction_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
call IO_error(500,ext_msg=trim(tag))
end select
endif
@ -517,14 +497,14 @@ subroutine material_parseHomogenization
case(DAMAGE_NONLOCAL_label)
damage_type(h) = DAMAGE_nonlocal_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
call IO_error(500,ext_msg=trim(tag))
end select
endif
enddo
do h=1_pInt, size(config_homogenization)
do h=1, size(config_homogenization)
homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h))
thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h))
damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h))
@ -550,58 +530,58 @@ subroutine material_parseMicrostructure
character(len=65536), dimension(:), allocatable :: &
strings
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: e, m, c, i
integer, allocatable, dimension(:) :: chunkPos
integer :: e, m, c, i
character(len=65536) :: &
tag
allocate(microstructure_crystallite(size(config_microstructure)), source=0_pInt)
allocate(microstructure_Nconstituents(size(config_microstructure)), source=0_pInt)
allocate(microstructure_crystallite(size(config_microstructure)), source=0)
allocate(microstructure_Nconstituents(size(config_microstructure)), source=0)
allocate(microstructure_active(size(config_microstructure)), source=.false.)
allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.)
if(any(theMesh%microstructureAt > size(config_microstructure))) &
call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config')
call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config')
forall (e = 1_pInt:theMesh%Nelems) &
forall (e = 1:theMesh%Nelems) &
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)
do m=1, size(config_microstructure)
microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)')
microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite')
microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/')
enddo
microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt)
allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt)
allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0)
allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0)
allocate(microstructure_fraction(microstructure_maxNconstituents,size(config_microstructure)),source=0.0_pReal)
allocate(strings(1)) ! Intel 16.0 Bug
do m=1_pInt, size(config_microstructure)
do m=1, size(config_microstructure)
strings = config_microstructure(m)%getStrings('(constituent)',raw=.true.)
do c = 1_pInt, size(strings)
do c = 1, size(strings)
chunkPos = IO_stringPos(strings(c))
do i = 1_pInt,5_pInt,2_pInt
do i = 1,5,2
tag = IO_stringValue(strings(c),chunkPos,i)
select case (tag)
case('phase')
microstructure_phase(c,m) = IO_intValue(strings(c),chunkPos,i+1_pInt)
microstructure_phase(c,m) = IO_intValue(strings(c),chunkPos,i+1)
case('texture')
microstructure_texture(c,m) = IO_intValue(strings(c),chunkPos,i+1_pInt)
microstructure_texture(c,m) = IO_intValue(strings(c),chunkPos,i+1)
case('fraction')
microstructure_fraction(c,m) = IO_floatValue(strings(c),chunkPos,i+1_pInt)
microstructure_fraction(c,m) = IO_floatValue(strings(c),chunkPos,i+1)
end select
enddo
enddo
enddo
do m = 1_pInt, size(config_microstructure)
do m = 1, size(config_microstructure)
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) &
call IO_error(153_pInt,ext_msg=microstructure_name(m))
call IO_error(153,ext_msg=microstructure_name(m))
enddo
end subroutine material_parseMicrostructure
@ -612,10 +592,10 @@ end subroutine material_parseMicrostructure
!--------------------------------------------------------------------------------------------------
subroutine material_parseCrystallite
integer(pInt) :: c
integer :: c
allocate(crystallite_Noutput(size(config_crystallite)),source=0_pInt)
do c=1_pInt, size(config_crystallite)
allocate(crystallite_Noutput(size(config_crystallite)),source=0)
do c=1, size(config_crystallite)
crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)')
enddo
@ -631,19 +611,19 @@ subroutine material_parsePhase
IO_getTag, &
IO_stringValue
integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
character(len=65536), dimension(:), allocatable :: str
allocate(phase_elasticity(size(config_phase)),source=ELASTICITY_undefined_ID)
allocate(phase_plasticity(size(config_phase)),source=PLASTICITY_undefined_ID)
allocate(phase_Nsources(size(config_phase)), source=0_pInt)
allocate(phase_Nkinematics(size(config_phase)), source=0_pInt)
allocate(phase_NstiffnessDegradations(size(config_phase)),source=0_pInt)
allocate(phase_Noutput(size(config_phase)), source=0_pInt)
allocate(phase_Nsources(size(config_phase)), source=0)
allocate(phase_Nkinematics(size(config_phase)), source=0)
allocate(phase_NstiffnessDegradations(size(config_phase)),source=0)
allocate(phase_Noutput(size(config_phase)), source=0)
allocate(phase_localPlasticity(size(config_phase)), source=.false.)
do p=1_pInt, size(config_phase)
do p=1, size(config_phase)
phase_Noutput(p) = config_phase(p)%countKeys('(output)')
phase_Nsources(p) = config_phase(p)%countKeys('(source)')
phase_Nkinematics(p) = config_phase(p)%countKeys('(kinematics)')
@ -654,7 +634,7 @@ subroutine material_parsePhase
case (ELASTICITY_HOOKE_label)
phase_elasticity(p) = ELASTICITY_HOOKE_ID
case default
call IO_error(200_pInt,ext_msg=trim(config_phase(p)%getString('elasticity')))
call IO_error(200,ext_msg=trim(config_phase(p)%getString('elasticity')))
end select
select case (config_phase(p)%getString('plasticity'))
@ -673,7 +653,7 @@ subroutine material_parsePhase
case (PLASTICITY_NONLOCAL_label)
phase_plasticity(p) = PLASTICITY_NONLOCAL_ID
case default
call IO_error(201_pInt,ext_msg=trim(config_phase(p)%getString('plasticity')))
call IO_error(201,ext_msg=trim(config_phase(p)%getString('plasticity')))
end select
enddo
@ -682,7 +662,7 @@ subroutine material_parsePhase
allocate(phase_kinematics(maxval(phase_Nkinematics),size(config_phase)), source=KINEMATICS_undefined_ID)
allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), &
source=STIFFNESS_DEGRADATION_undefined_ID)
do p=1_pInt, size(config_phase)
do p=1, size(config_phase)
#if defined(__GFORTRAN__) || defined(__PGI)
str = ['GfortranBug86277']
str = config_phase(p)%getStrings('(source)',defaultVal=str)
@ -690,7 +670,7 @@ subroutine material_parsePhase
#else
str = config_phase(p)%getStrings('(source)',defaultVal=[character(len=65536)::])
#endif
do sourceCtr = 1_pInt, size(str)
do sourceCtr = 1, size(str)
select case (trim(str(sourceCtr)))
case (SOURCE_thermal_dissipation_label)
phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID
@ -714,7 +694,7 @@ subroutine material_parsePhase
#else
str = config_phase(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::])
#endif
do kinematicsCtr = 1_pInt, size(str)
do kinematicsCtr = 1, size(str)
select case (trim(str(kinematicsCtr)))
case (KINEMATICS_cleavage_opening_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID
@ -731,7 +711,7 @@ subroutine material_parsePhase
#else
str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::])
#endif
do stiffDegradationCtr = 1_pInt, size(str)
do stiffDegradationCtr = 1, size(str)
select case (trim(str(stiffDegradationCtr)))
case (STIFFNESS_DEGRADATION_damage_label)
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID
@ -739,10 +719,10 @@ subroutine material_parsePhase
enddo
enddo
allocate(phase_plasticityInstance(size(config_phase)), source=0_pInt)
allocate(phase_elasticityInstance(size(config_phase)), source=0_pInt)
allocate(phase_plasticityInstance(size(config_phase)), source=0)
allocate(phase_elasticityInstance(size(config_phase)), source=0)
do p=1_pInt, size(config_phase)
do p=1, size(config_phase)
phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p))
phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p))
enddo
@ -759,13 +739,13 @@ subroutine material_parseTexture
IO_floatValue, &
IO_stringValue
integer(pInt) :: section, gauss, j, t, i
integer :: section, gauss, j, t, i
character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config
integer(pInt), dimension(:), allocatable :: chunkPos
integer, dimension(:), allocatable :: chunkPos
allocate(texture_Ngauss(size(config_texture)), source=0_pInt)
allocate(texture_Ngauss(size(config_texture)), source=0)
do t=1_pInt, size(config_texture)
do t=1, size(config_texture)
texture_Ngauss(t) = config_texture(t)%countKeys('(gauss)')
if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry')
if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)')
@ -777,13 +757,13 @@ subroutine material_parseTexture
allocate(texture_transformation(3,3,size(config_texture)), source=0.0_pReal)
texture_transformation = spread(math_I3,3,size(config_texture))
do t=1_pInt, size(config_texture)
do t=1, size(config_texture)
section = t
gauss = 0_pInt
gauss = 0
if (config_texture(t)%keyExists('axes')) then
strings = config_texture(t)%getStrings('axes')
do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries
do j = 1, 3 ! look for "x", "y", and "z" entries
select case (strings(j))
case('x', '+x')
texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
@ -798,25 +778,25 @@ subroutine material_parseTexture
case('-z')
texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
case default
call IO_error(157_pInt,t)
call IO_error(157,t)
end select
enddo
if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t)
if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157,t)
endif
if (config_texture(t)%keyExists('(gauss)')) then
gauss = gauss + 1_pInt
gauss = gauss + 1
strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
do i = 1_pInt , size(strings)
do i = 1 , size(strings)
chunkPos = IO_stringPos(strings(i))
do j = 1_pInt,9_pInt,2_pInt
do j = 1,9,2
select case (IO_stringValue(strings(i),chunkPos,j))
case('phi1')
texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
case('phi')
texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
case('phi2')
texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
end select
enddo
enddo
@ -837,7 +817,7 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,&
use numerics, only: &
numerics_integrator
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
NofMyPhase, &
sizeState, &
@ -862,13 +842,13 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,&
allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (numerics_integrator == 1_pInt) then
if (numerics_integrator == 1) then
allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (numerics_integrator == 4_pInt) &
if (numerics_integrator == 4) &
allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (numerics_integrator == 5_pInt) &
if (numerics_integrator == 5) &
allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
@ -884,7 +864,7 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,&
use numerics, only: &
numerics_integrator
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
of, &
NofMyPhase, &
@ -902,13 +882,13 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,&
allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (numerics_integrator == 1_pInt) then
if (numerics_integrator == 1) then
allocate(sourceState(phase)%p(of)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (numerics_integrator == 4_pInt) &
if (numerics_integrator == 4) &
allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (numerics_integrator == 5_pInt) &
if (numerics_integrator == 5) &
allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
@ -925,10 +905,10 @@ subroutine material_populateGrains
use mesh, only: &
theMesh
integer(pInt) :: e,i,c,homog,micro
integer :: e,i,c,homog,micro
allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0)
allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0)
allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal)
do e = 1, theMesh%Nelems

29
src/math.f90
View File

@ -10,12 +10,20 @@ module math
use future
implicit none
real(pReal), parameter, public :: PI = acos(-1.0_pReal) !< ratio of a circle's circumference to its diameter
real(pReal), parameter, public :: INDEG = 180.0_pReal/PI !< conversion from radian into degree
real(pReal), parameter, public :: INRAD = PI/180.0_pReal !< conversion from degree into radian
complex(pReal), parameter, public :: TWOPIIMG = cmplx(0.0_pReal,2.0_pReal*PI) !< Re(0.0), Im(2xPi)
public
#if __INTEL_COMPILER >= 1900
! do not make use associated entities available to other modules
private :: &
prec, &
future
#endif
real(pReal), dimension(3,3), parameter, public :: &
real(pReal), parameter :: PI = acos(-1.0_pReal) !< ratio of a circle's circumference to its diameter
real(pReal), parameter :: INDEG = 180.0_pReal/PI !< conversion from radian into degree
real(pReal), parameter :: INRAD = PI/180.0_pReal !< conversion from degree into radian
complex(pReal), parameter :: TWOPIIMG = cmplx(0.0_pReal,2.0_pReal*PI) !< Re(0.0), Im(2xPi)
real(pReal), dimension(3,3), parameter :: &
MATH_I3 = reshape([&
1.0_pReal,0.0_pReal,0.0_pReal, &
0.0_pReal,1.0_pReal,0.0_pReal, &
@ -75,7 +83,7 @@ module math
!---------------------------------------------------------------------------------------------------
private :: &
math_check
unitTest
contains
@ -116,14 +124,15 @@ subroutine math_init
write(6,'(a,4(/,26x,f17.14),/)') ' start of random sequence: ', randTest
call random_seed(put = randInit)
call math_check
call unitTest
end subroutine math_init
!--------------------------------------------------------------------------------------------------
!> @brief check correctness of (some) math functions
!--------------------------------------------------------------------------------------------------
subroutine math_check
subroutine unitTest
use IO, only: IO_error
character(len=64) :: error_msg
@ -145,7 +154,7 @@ subroutine math_check
call IO_error(401,ext_msg=error_msg)
endif
end subroutine math_check
end subroutine unitTest
!--------------------------------------------------------------------------------------------------
@ -274,6 +283,7 @@ pure function math_identity2nd(dimen)
end function math_identity2nd
!--------------------------------------------------------------------------------------------------
!> @brief symmetric fourth rank identity tensor of specified dimension
! from http://en.wikipedia.org/wiki/Tensor_derivative_(continuum_mechanics)#Derivative_of_a_second-order_tensor_with_respect_to_itself
@ -626,6 +636,7 @@ pure function math_skew33(m)
end function math_skew33
!--------------------------------------------------------------------------------------------------
!> @brief hydrostatic part of a 33 matrix
!--------------------------------------------------------------------------------------------------

1028
src/mesh_abaqus.f90
View File

File diff suppressed because it is too large Load Diff

10
src/mesh_base.f90
View File

@ -9,12 +9,8 @@
module mesh_base
use, intrinsic :: iso_c_binding
use prec, only: &
pStringLen, &
pReal, &
pInt
use element, only: &
tElement
use prec
use element
use future
implicit none
@ -54,7 +50,6 @@ module mesh_base
contains
subroutine tMesh_base_init(self,meshType,elemType,nodes)
implicit none
class(tMesh) :: self
character(len=*), intent(in) :: meshType
integer(pInt), intent(in) :: elemType
@ -75,7 +70,6 @@ end subroutine tMesh_base_init
subroutine tMesh_base_setNelems(self,Nelems)
implicit none
class(tMesh) :: self
integer(pInt), intent(in) :: Nelems

806
src/mesh_marc.f90
View File

File diff suppressed because it is too large Load Diff

86
src/numerics.f90
View File

@ -4,21 +4,14 @@
!> @brief Managing of parameters related to numerics
!--------------------------------------------------------------------------------------------------
module numerics
use prec, only: &
pInt, &
pReal
use prec
implicit none
private
integer(pInt), protected, public :: &
iJacoStiffness = 1_pInt, & !< frequency of stiffness update
iJacoLpresiduum = 1_pInt, & !< frequency of Jacobian update of residuum in Lp
nMPstate = 10_pInt, & !< materialpoint state loop limit
nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst")
nState = 10_pInt, & !< state loop limit
nStress = 40_pInt, & !< stress loop limit
pert_method = 1_pInt, & !< method used in perturbation technique for tangent
randomSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed
worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only)
worldsize = 1_pInt, & !< MPI worldsize (/=1 for MPI simulations only)
@ -26,20 +19,10 @@ module numerics
integer(4), protected, public :: &
DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
real(pReal), protected, public :: &
relevantStrain = 1.0e-7_pReal, & !< strain increment considered significant (used by crystallite to determine whether strain inc is considered significant)
defgradTolerance = 1.0e-7_pReal, & !< deviation of deformation gradient that is still allowed (used by CPFEM to determine outdated ffn1)
pert_Fg = 1.0e-7_pReal, & !< strain perturbation for FEM Jacobi
subStepMinCryst = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in crystallite
subStepMinHomog = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in homogenization
subStepSizeCryst = 0.25_pReal, & !< size of first substep when cutback in crystallite
subStepSizeHomog = 0.25_pReal, & !< size of first substep when cutback in homogenization
subStepSizeLp = 0.5_pReal, & !< size of first substep when cutback in Lp calculation
subStepSizeLi = 0.5_pReal, & !< size of first substep when cutback in Li calculation
stepIncreaseCryst = 1.5_pReal, & !< increase of next substep size when previous substep converged in crystallite
stepIncreaseHomog = 1.5_pReal, & !< increase of next substep size when previous substep converged in homogenization
rTol_crystalliteState = 1.0e-6_pReal, & !< relative tolerance in crystallite state loop
rTol_crystalliteStress = 1.0e-6_pReal, & !< relative tolerance in crystallite stress loop
aTol_crystalliteStress = 1.0e-8_pReal, & !< absolute tolerance in crystallite stress loop, Default 1.0e-8: residuum is in Lp and hence strain is on this order
numerics_unitlength = 1.0_pReal, & !< determines the physical length of one computational length unit
absTol_RGC = 1.0e+4_pReal, & !< absolute tolerance of RGC residuum
relTol_RGC = 1.0e-3_pReal, & !< relative tolerance of RGC residuum
@ -57,8 +40,7 @@ module numerics
charLength = 1.0_pReal, & !< characteristic length scale for gradient problems
residualStiffness = 1.0e-6_pReal !< non-zero residual damage
logical, protected, public :: &
usePingPong = .true., &
numerics_timeSyncing = .false. !< flag indicating if time synchronization in crystallite is used for nonlocal plasticity
usePingPong = .true.
!--------------------------------------------------------------------------------------------------
! field parameters:
@ -131,8 +113,6 @@ contains
! a sanity check
!--------------------------------------------------------------------------------------------------
subroutine numerics_init
use prec, only: &
pStringLen
use IO, only: &
IO_read_ASCII, &
IO_error, &
@ -148,7 +128,6 @@ subroutine numerics_init
use petscsys
#endif
!$ use OMP_LIB, only: omp_set_num_threads
implicit none
!$ integer :: gotDAMASK_NUM_THREADS = 1
integer :: i,j, ierr ! no pInt
integer(pInt), allocatable, dimension(:) :: chunkPos
@ -194,48 +173,18 @@ subroutine numerics_init
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('relevantstrain')
relevantStrain = IO_floatValue(line,chunkPos,2_pInt)
case ('defgradtolerance')
defgradTolerance = IO_floatValue(line,chunkPos,2_pInt)
case ('ijacostiffness')
iJacoStiffness = IO_intValue(line,chunkPos,2_pInt)
case ('ijacolpresiduum')
iJacoLpresiduum = IO_intValue(line,chunkPos,2_pInt)
case ('pert_fg')
pert_Fg = IO_floatValue(line,chunkPos,2_pInt)
case ('pert_method')
pert_method = IO_intValue(line,chunkPos,2_pInt)
case ('nmpstate')
nMPstate = IO_intValue(line,chunkPos,2_pInt)
case ('ncryst')
nCryst = IO_intValue(line,chunkPos,2_pInt)
case ('nstate')
nState = IO_intValue(line,chunkPos,2_pInt)
case ('nstress')
nStress = IO_intValue(line,chunkPos,2_pInt)
case ('substepmincryst')
subStepMinCryst = IO_floatValue(line,chunkPos,2_pInt)
case ('substepsizecryst')
subStepSizeCryst = IO_floatValue(line,chunkPos,2_pInt)
case ('stepincreasecryst')
stepIncreaseCryst = IO_floatValue(line,chunkPos,2_pInt)
case ('substepsizelp')
subStepSizeLp = IO_floatValue(line,chunkPos,2_pInt)
case ('substepsizeli')
subStepSizeLi = IO_floatValue(line,chunkPos,2_pInt)
case ('substepminhomog')
subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt)
case ('substepsizehomog')
subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt)
case ('stepincreasehomog')
stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt)
case ('rtol_crystallitestate')
rTol_crystalliteState = IO_floatValue(line,chunkPos,2_pInt)
case ('rtol_crystallitestress')
rTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt)
case ('atol_crystallitestress')
aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt)
case ('integrator')
numerics_integrator = IO_intValue(line,chunkPos,2_pInt)
case ('usepingpong')
@ -356,23 +305,8 @@ subroutine numerics_init
!--------------------------------------------------------------------------------------------------
! writing parameters to output
write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain
write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance
write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness
write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum
write(6,'(a24,1x,es8.1)') ' pert_Fg: ',pert_Fg
write(6,'(a24,1x,i8)') ' pert_method: ',pert_method
write(6,'(a24,1x,i8)') ' nCryst: ',nCryst
write(6,'(a24,1x,es8.1)') ' subStepMinCryst: ',subStepMinCryst
write(6,'(a24,1x,es8.1)') ' subStepSizeCryst: ',subStepSizeCryst
write(6,'(a24,1x,es8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst
write(6,'(a24,1x,es8.1)') ' subStepSizeLp: ',subStepSizeLp
write(6,'(a24,1x,es8.1)') ' subStepSizeLi: ',subStepSizeLi
write(6,'(a24,1x,i8)') ' nState: ',nState
write(6,'(a24,1x,i8)') ' nStress: ',nStress
write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState
write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress
write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress
write(6,'(a24,1x,i8)') ' integrator: ',numerics_integrator
write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong
write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength
@ -452,28 +386,12 @@ subroutine numerics_init
!--------------------------------------------------------------------------------------------------
! sanity checks
if (relevantStrain <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relevantStrain')
if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance')
if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness')
if (iJacoLpresiduum < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoLpresiduum')
if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg')
if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) &
call IO_error(301_pInt,ext_msg='pert_method')
if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate')
if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst')
if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState')
if (nStress < 1_pInt) call IO_error(301_pInt,ext_msg='nStress')
if (subStepMinCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinCryst')
if (subStepSizeCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeCryst')
if (stepIncreaseCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseCryst')
if (subStepSizeLp <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeLp')
if (subStepSizeLi <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeLi')
if (subStepMinHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinHomog')
if (subStepSizeHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeHomog')
if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseHomog')
if (rTol_crystalliteState <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteState')
if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteStress')
if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='aTol_crystalliteStress')
if (numerics_integrator <= 0_pInt .or. numerics_integrator >= 6_pInt) &
call IO_error(301_pInt,ext_msg='integrator')
if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength')

107
src/plastic_dislotwin.f90
View File

@ -8,17 +8,26 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module plastic_dislotwin
use prec, only: &
pReal
use prec
use debug
use math
use IO
use material
use config
use lattice
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
#endif
implicit none
private
integer, dimension(:,:), allocatable, target, public :: &
plastic_dislotwin_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
plastic_dislotwin_output !< name of each post result output
real(pReal), parameter, private :: &
real(pReal), parameter :: &
kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin
enum, bind(c)
@ -39,7 +48,7 @@ module plastic_dislotwin
f_tr_ID
end enum
type, private :: tParameters
type :: tParameters
real(pReal) :: &
mu, &
nu, &
@ -119,7 +128,7 @@ module plastic_dislotwin
dipoleFormation !< flag indicating consideration of dipole formation
end type !< container type for internal constitutive parameters
type, private :: tDislotwinState
type :: tDislotwinState
real(pReal), dimension(:,:), pointer :: &
rho_mob, &
rho_dip, &
@ -128,7 +137,7 @@ module plastic_dislotwin
f_tr
end type tDislotwinState
type, private :: tDislotwinMicrostructure
type :: tDislotwinMicrostructure
real(pReal), dimension(:,:), allocatable :: &
Lambda_sl, & !* mean free path between 2 obstacles seen by a moving dislocation
Lambda_tw, & !* mean free path between 2 obstacles seen by a growing twin
@ -144,11 +153,11 @@ module plastic_dislotwin
!--------------------------------------------------------------------------------------------------
! containers for parameters and state
type(tParameters), allocatable, dimension(:), private :: param
type(tDislotwinState), allocatable, dimension(:), private :: &
type(tParameters), allocatable, dimension(:) :: param
type(tDislotwinState), allocatable, dimension(:) :: &
dotState, &
state
type(tDislotwinMicrostructure), allocatable, dimension(:), private :: dependentState
type(tDislotwinMicrostructure), allocatable, dimension(:) :: dependentState
public :: &
plastic_dislotwin_init, &
@ -158,10 +167,6 @@ module plastic_dislotwin
plastic_dislotwin_dotState, &
plastic_dislotwin_postResults, &
plastic_dislotwin_results
private :: &
kinetics_slip, &
kinetics_twin, &
kinetics_trans
contains
@ -171,24 +176,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_dislotwin_init
use prec, only: &
pStringLen, &
dEq0, &
dNeq0, &
dNeq
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use math, only: &
math_expand,&
PI
use IO, only: &
IO_error
use material
use config, only: &
config_phase
use lattice
integer :: &
Ninstance, &
@ -591,10 +578,6 @@ end subroutine plastic_dislotwin_init
!> @brief returns the homogenized elasticity matrix
!--------------------------------------------------------------------------------------------------
function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC)
use material, only: &
material_phase, &
phase_plasticityInstance, &
phasememberAt
real(pReal), dimension(6,6) :: &
homogenizedC
@ -634,14 +617,6 @@ end function plastic_dislotwin_homogenizedC
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of)
use prec, only: &
tol_math_check, &
dNeq0
use math, only: &
math_eigenValuesVectorsSym, &
math_outer, &
math_symmetric33, &
math_mul33xx33
real(pReal), dimension(3,3), intent(out) :: Lp
real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp
@ -757,13 +732,6 @@ end subroutine plastic_dislotwin_LpAndItsTangent
!> @brief calculates the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
subroutine plastic_dislotwin_dotState(Mp,T,instance,of)
use prec, only: &
tol_math_check, &
dEq0
use math, only: &
math_clip, &
math_mul33xx33, &
PI
real(pReal), dimension(3,3), intent(in):: &
Mp !< Mandel stress
@ -854,8 +822,6 @@ end subroutine plastic_dislotwin_dotState
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
subroutine plastic_dislotwin_dependentState(T,instance,of)
use math, only: &
PI
integer, intent(in) :: &
instance, &
@ -868,13 +834,13 @@ subroutine plastic_dislotwin_dependentState(T,instance,of)
real(pReal) :: &
sumf_twin,SFE,sumf_trans
real(pReal), dimension(param(instance)%sum_N_sl) :: &
inv_lambda_sl_sl, & !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation
inv_lambda_sl_tw, & !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation
inv_lambda_sl_tr !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation
inv_lambda_sl_sl, & !< 1/mean free distance between 2 forest dislocations seen by a moving dislocation
inv_lambda_sl_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation
inv_lambda_sl_tr !< 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation
real(pReal), dimension(param(instance)%sum_N_tw) :: &
inv_lambda_tw_tw !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin
inv_lambda_tw_tw !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin
real(pReal), dimension(param(instance)%sum_N_tr) :: &
inv_lambda_tr_tr !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans)
inv_lambda_tr_tr !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite
real(pReal), dimension(:), allocatable :: &
x0, &
@ -967,12 +933,6 @@ end subroutine plastic_dislotwin_dependentState
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_dislotwin_postResults(Mp,T,instance,of) result(postResults)
use prec, only: &
tol_math_check, &
dEq0
use math, only: &
PI, &
math_mul33xx33
real(pReal), dimension(3,3),intent(in) :: &
Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation
@ -1050,8 +1010,6 @@ end function plastic_dislotwin_postResults
!--------------------------------------------------------------------------------------------------
subroutine plastic_dislotwin_results(instance,group)
#if defined(PETSc) || defined(DAMASK_HDF5)
use results, only: &
results_writeDataset
integer, intent(in) :: instance
character(len=*) :: group
@ -1067,8 +1025,8 @@ subroutine plastic_dislotwin_results(instance,group)
case (rho_dip_ID)
call results_writeDataset(group,stt%rho_dip,'rho_dip',&
'dislocation dipole density''1/m²')
case (dot_gamma_sl_ID)
call results_writeDataset(group,stt%gamma_sl,'dot_gamma_sl',&
case (gamma_sl_ID)
call results_writeDataset(group,stt%gamma_sl,'gamma_sl',&
'plastic shear','1')
case (Lambda_sl_ID)
call results_writeDataset(group,dst%Lambda_sl,'Lambda_sl',&
@ -1112,11 +1070,6 @@ end subroutine plastic_dislotwin_results
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_slip(Mp,T,instance,of, &
dot_gamma_sl,ddot_gamma_dtau_slip,tau_slip)
use prec, only: &
tol_math_check, &
dNeq0
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -1190,11 +1143,6 @@ end subroutine kinetics_slip
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,&
dot_gamma_twin,ddot_gamma_dtau_twin)
use prec, only: &
tol_math_check, &
dNeq0
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -1261,11 +1209,6 @@ end subroutine kinetics_twin
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,&
dot_gamma_tr,ddot_gamma_dtau_trans)
use prec, only: &
tol_math_check, &
dNeq0
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress

61
src/plastic_isotropic.f90
View File

@ -8,11 +8,19 @@
!! untextured polycrystal
!--------------------------------------------------------------------------------------------------
module plastic_isotropic
use prec, only: &
pReal
use prec
use debug
use math
use IO
use material
use config
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
#endif
implicit none
private
integer, dimension(:,:), allocatable, target, public :: &
plastic_isotropic_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
@ -25,7 +33,7 @@ module plastic_isotropic
dot_gamma_ID
end enum
type, private :: tParameters
type :: tParameters
real(pReal) :: &
M, & !< Taylor factor
xi_0, & !< initial critical stress
@ -49,7 +57,7 @@ module plastic_isotropic
dilatation
end type tParameters
type, private :: tIsotropicState
type :: tIsotropicState
real(pReal), pointer, dimension(:) :: &
xi, &
gamma
@ -57,8 +65,8 @@ module plastic_isotropic
!--------------------------------------------------------------------------------------------------
! containers for parameters and state
type(tParameters), allocatable, dimension(:), private :: param
type(tIsotropicState), allocatable, dimension(:), private :: &
type(tParameters), allocatable, dimension(:) :: param
type(tIsotropicState), allocatable, dimension(:) :: &
dotState, &
state
@ -77,24 +85,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_init
use prec, only: &
pStringLen
use debug, only: &
#ifdef DEBUG
debug_e, &
debug_i, &
debug_g, &
debug_levelExtensive, &
#endif
debug_level, &
debug_constitutive, &
debug_levelBasic
use IO, only: &
IO_error
use material
use config, only: &
config_phase
use lattice
integer :: &
Ninstance, &
@ -235,16 +225,6 @@ end subroutine plastic_isotropic_init
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_constitutive,&
debug_levelExtensive, &
debug_levelSelective
#endif
use math, only: &
math_deviatoric33, &
math_mul33xx33
real(pReal), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
@ -307,10 +287,6 @@ end subroutine plastic_isotropic_LpAndItsTangent
! ToDo: Rename Tstar to Mi?
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
use math, only: &
math_I3, &
math_spherical33, &
math_mul33xx33
real(pReal), dimension(3,3), intent(out) :: &
Li !< inleastic velocity gradient
@ -362,11 +338,6 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
!> @brief calculates the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_dotState(Mp,instance,of)
use prec, only: &
dEq0
use math, only: &
math_mul33xx33, &
math_deviatoric33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -416,9 +387,6 @@ end subroutine plastic_isotropic_dotState
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_isotropic_postResults(Mp,instance,of) result(postResults)
use math, only: &
math_mul33xx33, &
math_deviatoric33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -468,7 +436,6 @@ end function plastic_isotropic_postResults
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_results(instance,group)
#if defined(PETSc) || defined(DAMASKHDF5)
use results
integer, intent(in) :: instance
character(len=*), intent(in) :: group

62
src/plastic_kinematichardening.f90
View File

@ -6,11 +6,20 @@
!! and a Voce-type kinematic hardening rule
!--------------------------------------------------------------------------------------------------
module plastic_kinehardening
use prec, only: &
pReal
use prec
use debug
use math
use IO
use material
use config
use lattice
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
#endif
implicit none
private
integer, dimension(:,:), allocatable, target, public :: &
plastic_kinehardening_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
@ -29,7 +38,7 @@ module plastic_kinehardening
resolvedstress_ID
end enum
type, private :: tParameters
type :: tParameters
real(pReal) :: &
gdot0, & !< reference shear strain rate for slip
n, & !< stress exponent for slip
@ -59,7 +68,7 @@ module plastic_kinehardening
outputID !< ID of each post result output
end type tParameters
type, private :: tKinehardeningState
type :: tKinehardeningState
real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance
crss, & !< critical resolved stress
crss_back, & !< critical resolved back stress
@ -71,8 +80,8 @@ module plastic_kinehardening
!--------------------------------------------------------------------------------------------------
! containers for parameters and state
type(tParameters), allocatable, dimension(:), private :: param
type(tKinehardeningState), allocatable, dimension(:), private :: &
type(tParameters), allocatable, dimension(:) :: param
type(tKinehardeningState), allocatable, dimension(:) :: &
dotState, &
deltaState, &
state
@ -84,8 +93,6 @@ module plastic_kinehardening
plastic_kinehardening_deltaState, &
plastic_kinehardening_postResults, &
plastic_kinehardening_results
private :: &
kinetics
contains
@ -95,27 +102,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_init
use prec, only: &
dEq0, &
pStringLen
use debug, only: &
#ifdef DEBUG
debug_e, &
debug_i, &
debug_g, &
debug_levelExtensive, &
#endif
debug_level, &
debug_constitutive,&
debug_levelBasic
use math, only: &
math_expand
use IO, only: &
IO_error
use material
use config, only: &
config_phase
use lattice
integer :: &
Ninstance, &
@ -417,16 +403,6 @@ end subroutine plastic_kinehardening_dotState
!> @brief calculates (instantaneous) incremental change of microstructure
!--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_deltaState(Mp,instance,of)
use prec, only: &
dNeq, &
dEq0
#ifdef DEBUG
use debug, only: &
debug_level, &
debug_constitutive,&
debug_levelExtensive, &
debug_levelSelective
#endif
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -475,8 +451,6 @@ end subroutine plastic_kinehardening_deltaState
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_kinehardening_postResults(Mp,instance,of) result(postResults)
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -535,8 +509,6 @@ end function plastic_kinehardening_postResults
!--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_results(instance,group)
#if defined(PETSc) || defined(DAMASK_HDF5)
use results, only: &
results_writeDataset
integer, intent(in) :: instance
character(len=*) :: group
@ -585,10 +557,6 @@ end subroutine plastic_kinehardening_results
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics(Mp,instance,of, &
gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg)
use prec, only: &
dNeq0
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress

7
src/plastic_none.f90
View File

@ -5,6 +5,8 @@
!> @brief Dummy plasticity for purely elastic material
!--------------------------------------------------------------------------------------------------
module plastic_none
use material
use debug
implicit none
private
@ -19,11 +21,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_none_init
use debug, only: &
debug_level, &
debug_constitutive, &
debug_levelBasic
use material
integer :: &
Ninstance, &

50
src/plastic_phenopowerlaw.f90
View File

@ -5,11 +5,20 @@
!> @brief phenomenological crystal plasticity formulation using a powerlaw fitting
!--------------------------------------------------------------------------------------------------
module plastic_phenopowerlaw
use prec, only: &
pReal
use prec
use debug
use math
use IO
use material
use config
use lattice
#if defined(PETSc) || defined(DAMASK_HDF5)
use results
#endif
implicit none
private
integer, dimension(:,:), allocatable, target, public :: &
plastic_phenopowerlaw_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
@ -28,7 +37,7 @@ module plastic_phenopowerlaw
resolvedstress_twin_ID
end enum
type, private :: tParameters
type :: tParameters
real(pReal) :: &
gdot0_slip, & !< reference shear strain rate for slip
gdot0_twin, & !< reference shear strain rate for twin
@ -73,7 +82,7 @@ module plastic_phenopowerlaw
outputID !< ID of each post result output
end type tParameters
type, private :: tPhenopowerlawState
type :: tPhenopowerlawState
real(pReal), pointer, dimension(:,:) :: &
xi_slip, &
xi_twin, &
@ -83,8 +92,8 @@ module plastic_phenopowerlaw
!--------------------------------------------------------------------------------------------------
! containers for parameters and state
type(tParameters), allocatable, dimension(:), private :: param
type(tPhenopowerlawState), allocatable, dimension(:), private :: &
type(tParameters), allocatable, dimension(:) :: param
type(tPhenopowerlawState), allocatable, dimension(:) :: &
dotState, &
state
@ -94,9 +103,6 @@ module plastic_phenopowerlaw
plastic_phenopowerlaw_dotState, &
plastic_phenopowerlaw_postResults, &
plastic_phenopowerlaw_results
private :: &
kinetics_slip, &
kinetics_twin
contains
@ -106,20 +112,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_phenopowerlaw_init
use prec, only: &
pStringLen
use debug, only: &
debug_level, &
debug_constitutive,&
debug_levelBasic
use math, only: &
math_expand
use IO, only: &
IO_error
use material
use config, only: &
config_phase
use lattice
integer :: &
Ninstance, &
@ -484,8 +476,6 @@ end subroutine plastic_phenopowerlaw_dotState
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults)
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -552,8 +542,6 @@ end function plastic_phenopowerlaw_postResults
!--------------------------------------------------------------------------------------------------
subroutine plastic_phenopowerlaw_results(instance,group)
#if defined(PETSc) || defined(DAMASK_HDF5)
use results, only: &
results_writeDataset
integer, intent(in) :: instance
character(len=*), intent(in) :: group
@ -598,10 +586,6 @@ end subroutine plastic_phenopowerlaw_results
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_slip(Mp,instance,of, &
gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg)
use prec, only: &
dNeq0
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
@ -674,10 +658,6 @@ end subroutine kinetics_slip
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_twin(Mp,instance,of,&
gdot_twin,dgdot_dtau_twin)
use prec, only: &
dNeq0
use math, only: &
math_mul33xx33
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress

5
src/quaternions.f90
View File

@ -34,8 +34,7 @@
!> @details w is the real part, (x, y, z) are the imaginary parts.
!---------------------------------------------------------------------------------------------------
module quaternions
use prec, only: &
pReal
use prec
use future
implicit none
@ -286,8 +285,6 @@ end function div_scal__
!> equality of two quaternions
!---------------------------------------------------------------------------------------------------
logical elemental function eq__(self,other)
use prec, only: &
dEq
class(quaternion), intent(in) :: self,other

30
src/results.f90
View File

@ -5,6 +5,9 @@
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!--------------------------------------------------------------------------------------------------
module results
use DAMASK_interface
use rotations
use numerics
use HDF5_utilities
#ifdef PETSc
use PETSC
@ -55,8 +58,6 @@ module results
contains
subroutine results_init
use DAMASK_interface, only: &
getSolverJobName
character(len=pStringLen) :: commandLine
@ -83,9 +84,6 @@ end subroutine results_init
!> @brief opens the results file to append data
!--------------------------------------------------------------------------------------------------
subroutine results_openJobFile
use DAMASK_interface, only: &
getSolverJobName
resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.)
@ -301,16 +299,24 @@ subroutine results_writeTensorDataset_real(group,dataset,label,description,SIuni
character(len=*), intent(in) :: label,group,description
character(len=*), intent(in), optional :: SIunit
real(pReal), intent(inout), dimension(:,:,:) :: dataset
real(pReal), intent(in), dimension(:,:,:) :: dataset
integer :: i
integer(HID_T) :: groupHandle
real(pReal), dimension(:,:,:), allocatable :: dataset_transposed
allocate(dataset_transposed,mold=dataset)
do i=1,size(dataset,3)
dataset_transposed(1:3,1:3,i) = transpose(dataset(1:3,1:3,i))
enddo
groupHandle = results_openGroup(group)
#ifdef PETSc
call HDF5_write(groupHandle,dataset,label,.true.)
call HDF5_write(groupHandle,dataset_transposed,label,.true.)
#else
call HDF5_write(groupHandle,dataset,label,.false.)
call HDF5_write(groupHandle,dataset_transposed,label,.false.)
#endif
if (HDF5_objectExists(groupHandle,label)) &
@ -388,8 +394,6 @@ end subroutine results_writeTensorDataset_int
!> @brief stores a scalar dataset in a group
!--------------------------------------------------------------------------------------------------
subroutine results_writeScalarDataset_rotation(group,dataset,label,description,lattice_structure)
use rotations, only: &
rotation
character(len=*), intent(in) :: label,group,description
character(len=*), intent(in), optional :: lattice_structure
@ -420,9 +424,6 @@ end subroutine results_writeScalarDataset_rotation
!> @brief adds the unique mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine results_mapping_constituent(phaseAt,memberAt,label)
use numerics, only: &
worldrank, &
worldsize
integer, dimension(:,:), intent(in) :: phaseAt !< phase section at (constituent,element)
integer, dimension(:,:,:), intent(in) :: memberAt !< phase member at (constituent,IP,element)
@ -558,9 +559,6 @@ end subroutine results_mapping_constituent
!> @brief adds the unique mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine results_mapping_materialpoint(homogenizationAt,memberAt,label)
use numerics, only: &
worldrank, &
worldsize
integer, dimension(:), intent(in) :: homogenizationAt !< homogenization section at (element)
integer, dimension(:,:), intent(in) :: memberAt !< homogenization member at (IP,element)

86
src/rotations.f90
View File

@ -46,12 +46,15 @@
!---------------------------------------------------------------------------------------------------
module rotations
use prec, only: &
pReal
use prec
use IO
use math
use Lambert
use quaternions
implicit none
private
type, public :: rotation
type(quaternion), private :: q
contains
@ -148,8 +151,6 @@ end subroutine
!> @details: rotation is based on unit quaternion or rotation matrix (fallback)
!---------------------------------------------------------------------------------------------------
function rotVector(self,v,active)
use prec, only: &
dEq
real(pReal), dimension(3) :: rotVector
class(rotation), intent(in) :: self
@ -260,10 +261,6 @@ end function qu2om
!> @brief convert unit quaternion to Euler angles
!---------------------------------------------------------------------------------------------------
pure function qu2eu(qu) result(eu)
use prec, only: &
dEq0
use math, only: &
PI
type(quaternion), intent(in) :: qu
real(pReal), dimension(3) :: eu
@ -294,12 +291,6 @@ end function qu2eu
!> @brief convert unit quaternion to axis angle pair
!---------------------------------------------------------------------------------------------------
pure function qu2ax(qu) result(ax)
use prec, only: &
dEq0, &
dNeq0
use math, only: &
PI, &
math_clip
type(quaternion), intent(in) :: qu
real(pReal), dimension(4) :: ax
@ -324,13 +315,6 @@ end function qu2ax
!> @brief convert unit quaternion to Rodrigues vector
!---------------------------------------------------------------------------------------------------
pure function qu2ro(qu) result(ro)
use, intrinsic :: IEEE_ARITHMETIC, only: &
IEEE_value, &
IEEE_positive_inf
use prec, only: &
dEq0
use math, only: &
math_clip
type(quaternion), intent(in) :: qu
real(pReal), dimension(4) :: ro
@ -358,10 +342,6 @@ end function qu2ro
!> @brief convert unit quaternion to homochoric
!---------------------------------------------------------------------------------------------------
pure function qu2ho(qu) result(ho)
use prec, only: &
dEq0
use math, only: &
math_clip
type(quaternion), intent(in) :: qu
real(pReal), dimension(3) :: ho
@ -415,8 +395,6 @@ end function om2qu
!> @brief orientation matrix to Euler angles
!---------------------------------------------------------------------------------------------------
pure function om2eu(om) result(eu)
use math, only: &
PI
real(pReal), intent(in), dimension(3,3) :: om
real(pReal), dimension(3) :: eu
@ -441,15 +419,6 @@ end function om2eu
!> @brief convert orientation matrix to axis angle pair
!---------------------------------------------------------------------------------------------------
function om2ax(om) result(ax)
use prec, only: &
dEq0, &
cEq, &
dNeq0
use IO, only: &
IO_error
use math, only: &
math_clip, &
math_trace33
real(pReal), intent(in) :: om(3,3)
real(pReal) :: ax(4)
@ -560,8 +529,6 @@ end function eu2qu
!> @brief Euler angles to orientation matrix
!---------------------------------------------------------------------------------------------------
pure function eu2om(eu) result(om)
use prec, only: &
dEq0
real(pReal), intent(in), dimension(3) :: eu
real(pReal), dimension(3,3) :: om
@ -591,11 +558,6 @@ end function eu2om
!> @brief convert euler to axis angle
!---------------------------------------------------------------------------------------------------
pure function eu2ax(eu) result(ax)
use prec, only: &
dEq0, &
dEq
use math, only: &
PI
real(pReal), intent(in), dimension(3) :: eu
real(pReal), dimension(4) :: ax
@ -625,13 +587,6 @@ end function eu2ax
!> @brief Euler angles to Rodrigues vector
!---------------------------------------------------------------------------------------------------
pure function eu2ro(eu) result(ro)
use prec, only: &
dEq0
use, intrinsic :: IEEE_ARITHMETIC, only: &
IEEE_value, &
IEEE_positive_inf
use math, only: &
PI
real(pReal), intent(in), dimension(3) :: eu
real(pReal), dimension(4) :: ro
@ -681,8 +636,6 @@ end function eu2cu
!> @brief convert axis angle pair to quaternion
!---------------------------------------------------------------------------------------------------
pure function ax2qu(ax) result(qu)
use prec, only: &
dEq0
real(pReal), intent(in), dimension(4) :: ax
type(quaternion) :: qu
@ -755,13 +708,6 @@ end function ax2eu
!> @brief convert axis angle pair to Rodrigues vector
!---------------------------------------------------------------------------------------------------
pure function ax2ro(ax) result(ro)
use, intrinsic :: IEEE_ARITHMETIC, only: &
IEEE_value, &
IEEE_positive_inf
use prec, only: &
dEq0
use math, only: &
PI
real(pReal), intent(in), dimension(4) :: ax
real(pReal), dimension(4) :: ro
@ -858,12 +804,6 @@ end function ro2eu
!> @brief convert Rodrigues vector to axis angle pair
!---------------------------------------------------------------------------------------------------
pure function ro2ax(ro) result(ax)
use, intrinsic :: IEEE_ARITHMETIC, only: &
IEEE_is_finite
use prec, only: &
dEq0
use math, only: &
PI
real(pReal), intent(in), dimension(4) :: ro
real(pReal), dimension(4) :: ax
@ -890,12 +830,6 @@ end function ro2ax
!> @brief convert Rodrigues vector to homochoric
!---------------------------------------------------------------------------------------------------
pure function ro2ho(ro) result(ho)
use, intrinsic :: IEEE_ARITHMETIC, only: &
IEEE_is_finite
use prec, only: &
dEq0
use math, only: &
PI
real(pReal), intent(in), dimension(4) :: ro
real(pReal), dimension(3) :: ho
@ -973,8 +907,6 @@ end function ho2eu
!> @brief convert homochoric to axis angle pair
!---------------------------------------------------------------------------------------------------
pure function ho2ax(ho) result(ax)
use prec, only: &
dEq0
real(pReal), intent(in), dimension(3) :: ho
real(pReal), dimension(4) :: ax
@ -1029,13 +961,11 @@ end function ho2ro
!> @brief convert homochoric to cubochoric
!---------------------------------------------------------------------------------------------------
function ho2cu(ho) result(cu)
use Lambert, only: &
LambertBallToCube
real(pReal), intent(in), dimension(3) :: ho
real(pReal), dimension(3) :: cu
cu = LambertBallToCube(ho)
cu = Lambert_BallToCube(ho)
end function ho2cu
@ -1115,13 +1045,11 @@ end function cu2ro
!> @brief convert cubochoric to homochoric
!---------------------------------------------------------------------------------------------------
function cu2ho(cu) result(ho)
use Lambert, only: &
LambertCubeToBall
real(pReal), intent(in), dimension(3) :: cu
real(pReal), dimension(3) :: ho
ho = LambertCubeToBall(cu)
ho = Lambert_CubeToBall(cu)
end function cu2ho

129
src/source_damage_anisoBrittle.f90
View File

@ -5,23 +5,28 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_anisoBrittle
use prec, only: &
pReal, &
pInt
use prec
use debug
use IO
use math
use material
use config
use lattice
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
integer, dimension(:), allocatable, public, protected :: &
source_damage_anisoBrittle_offset, & !< which source is my current source mechanism?
source_damage_anisoBrittle_instance !< instance of source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
integer, dimension(:,:), allocatable, target, public :: &
source_damage_anisoBrittle_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_anisoBrittle_output !< name of each post result output
integer(pInt), dimension(:,:), allocatable, private :: &
integer, dimension(:,:), allocatable :: &
source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family
enum, bind(c)
@ -30,7 +35,7 @@ module source_damage_anisoBrittle
end enum
type, private :: tParameters !< container type for internal constitutive parameters
type :: tParameters !< container type for internal constitutive parameters
real(pReal) :: &
aTol, &
sdot_0, &
@ -40,15 +45,15 @@ module source_damage_anisoBrittle
critLoad
real(pReal), dimension(:,:,:,:), allocatable :: &
cleavage_systems
integer(pInt) :: &
integer :: &
totalNcleavage
integer(pInt), dimension(:), allocatable :: &
integer, dimension(:), allocatable :: &
Ncleavage
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID !< ID of each post result output
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -65,35 +70,10 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoBrittle_init
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_error
use math, only: &
math_expand
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_damage_anisoBrittle_label, &
SOURCE_damage_anisoBrittle_ID, &
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase
use lattice, only: &
lattice_SchmidMatrix_cleavage, &
lattice_maxNcleavageFamily
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p ,i
integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::]
integer :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p ,i
integer, dimension(0), parameter :: emptyIntArray = [integer::]
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
@ -105,14 +85,14 @@ subroutine source_damage_anisoBrittle_init
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>'
Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt)
if (Ninstance == 0_pInt) return
Ninstance = count(phase_source == SOURCE_damage_anisoBrittle_ID)
if (Ninstance == 0) 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_anisoBrittle_offset(material_Nphase), source=0_pInt)
allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt)
allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0)
allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0)
do phase = 1, material_Nphase
source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID)
do source = 1, phase_Nsources(phase)
@ -121,11 +101,11 @@ subroutine source_damage_anisoBrittle_init
enddo
enddo
allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt)
allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0)
allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance))
source_damage_anisoBrittle_output = ''
allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt)
allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0)
allocate(param(Ninstance))
@ -162,18 +142,18 @@ subroutine source_damage_anisoBrittle_init
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')')
call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
do i=1, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('anisobrittle_drivingforce')
source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1_pInt
source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1
source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
@ -189,7 +169,7 @@ subroutine source_damage_anisoBrittle_init
sourceOffset = source_damage_anisoBrittle_offset(phase)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
@ -197,33 +177,21 @@ subroutine source_damage_anisoBrittle_init
source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage
enddo
end subroutine source_damage_anisoBrittle_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
use math, only: &
math_mul33xx33
use material, only: &
phaseAt, phasememberAt, &
sourceState, &
material_homogenizationAt, &
damage, &
damageMapping
use lattice, only: &
lattice_Scleavage, &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), intent(in), dimension(3,3) :: &
S
integer(pInt) :: &
integer :: &
phase, &
constituent, &
instance, &
@ -243,10 +211,10 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
index = 1_pInt
do f = 1_pInt,lattice_maxNcleavageFamily
index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family
do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family
index = 1
do f = 1,lattice_maxNcleavageFamily
index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family
do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family
traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
@ -263,20 +231,19 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
(max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ &
param(instance)%critDisp(index)
index = index + 1_pInt
index = index + 1
enddo
enddo
end subroutine source_damage_anisoBrittle_dotState
!--------------------------------------------------------------------------------------------------
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), intent(in) :: &
@ -284,7 +251,7 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
integer :: &
sourceOffset
sourceOffset = source_damage_anisoBrittle_offset(phase)
@ -296,34 +263,34 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph
end subroutine source_damage_anisobrittle_getRateAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_anisoBrittle_postResults(phase, constituent)
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, &
source_damage_anisoBrittle_instance(phase)))) :: &
source_damage_anisoBrittle_postResults
integer(pInt) :: &
integer :: &
instance, sourceOffset, o, c
instance = source_damage_anisoBrittle_instance(phase)
sourceOffset = source_damage_anisoBrittle_offset(phase)
c = 0_pInt
c = 0
do o = 1_pInt,size(param(instance)%outputID)
do o = 1,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_anisoBrittle_postResults(c+1_pInt) = &
source_damage_anisoBrittle_postResults(c+1) = &
sourceState(phase)%p(sourceOffset)%state(1,constituent)
c = c + 1_pInt
c = c + 1
end select
enddo

54
src/source_damage_anisoDuctile.f90
View File

@ -5,17 +5,15 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_anisoDuctile
use prec, only: &
pReal, &
pInt
use prec
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
integer, dimension(:), allocatable, public, protected :: &
source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_anisoDuctile_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
integer, dimension(:,:), allocatable, target, public :: &
source_damage_anisoDuctile_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
@ -59,8 +57,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_init
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
@ -82,10 +78,10 @@ subroutine source_damage_anisoDuctile_init
config_phase
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p ,i
integer :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p ,i
integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::]
integer, dimension(0), parameter :: emptyIntArray = [integer::]
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
@ -98,13 +94,13 @@ subroutine source_damage_anisoDuctile_init
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>'
Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID)
if (Ninstance == 0_pInt) return
if (Ninstance == 0) 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_anisoDuctile_offset(size(config_phase)), source=0_pInt)
allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0_pInt)
allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0)
allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0)
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)
@ -113,7 +109,7 @@ subroutine source_damage_anisoDuctile_init
enddo
enddo
allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance))
source_damage_anisoDuctile_output = ''
@ -146,18 +142,18 @@ subroutine source_damage_anisoDuctile_init
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')')
call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
do i=1, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('anisoductile_drivingforce')
source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1_pInt
source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1
source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
@ -173,7 +169,7 @@ subroutine source_damage_anisoDuctile_init
instance = source_damage_anisoDuctile_instance(phase)
sourceOffset = source_damage_anisoDuctile_offset(phase)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
@ -193,11 +189,11 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
damage, &
damageMapping
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
integer(pInt) :: &
integer :: &
phase, &
constituent, &
sourceOffset, &
@ -229,7 +225,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), intent(in) :: &
@ -237,7 +233,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
integer :: &
sourceOffset
sourceOffset = source_damage_anisoDuctile_offset(phase)
@ -256,27 +252,27 @@ function source_damage_anisoDuctile_postResults(phase, constituent)
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, &
source_damage_anisoDuctile_instance(phase)))) :: &
source_damage_anisoDuctile_postResults
integer(pInt) :: &
integer :: &
instance, sourceOffset, o, c
instance = source_damage_anisoDuctile_instance(phase)
sourceOffset = source_damage_anisoDuctile_offset(phase)
c = 0_pInt
c = 0
do o = 1_pInt,size(param(instance)%outputID)
do o = 1,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_anisoDuctile_postResults(c+1_pInt) = &
source_damage_anisoDuctile_postResults(c+1) = &
sourceState(phase)%p(sourceOffset)%state(1,constituent)
c = c + 1_pInt
c = c + 1
end select
enddo

52
src/source_damage_isoBrittle.f90
View File

@ -5,17 +5,15 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_isoBrittle
use prec, only: &
pReal, &
pInt
use prec
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
integer, dimension(:), allocatable, public, protected :: &
source_damage_isoBrittle_offset, & !< which source is my current damage mechanism?
source_damage_isoBrittle_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
integer, dimension(:,:), allocatable, target, public :: &
source_damage_isoBrittle_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
@ -53,8 +51,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_init
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
@ -75,8 +71,8 @@ subroutine source_damage_isoBrittle_init
material_Nphase
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p,i
integer :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p,i
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
@ -88,14 +84,14 @@ subroutine source_damage_isoBrittle_init
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'
Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt)
if (Ninstance == 0_pInt) return
Ninstance = count(phase_source == SOURCE_damage_isoBrittle_ID)
if (Ninstance == 0) 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_isoBrittle_offset(material_Nphase), source=0_pInt)
allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt)
allocate(source_damage_isoBrittle_offset(material_Nphase), source=0)
allocate(source_damage_isoBrittle_instance(material_Nphase), source=0)
do phase = 1, material_Nphase
source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID)
do source = 1, phase_Nsources(phase)
@ -104,7 +100,7 @@ subroutine source_damage_isoBrittle_init
enddo
enddo
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance))
source_damage_isoBrittle_output = ''
@ -129,18 +125,18 @@ subroutine source_damage_isoBrittle_init
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
do i=1, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('isobrittle_drivingforce')
source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1_pInt
source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1
source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
@ -156,7 +152,7 @@ subroutine source_damage_isoBrittle_init
instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,1_pInt)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,1)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
@ -175,7 +171,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
math_sym33to6, &
math_I3
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
@ -183,7 +179,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
Fe
real(pReal), intent(in), dimension(6,6) :: &
C
integer(pInt) :: &
integer :: &
phase, constituent, instance, sourceOffset
real(pReal) :: &
strain(6), &
@ -219,7 +215,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), intent(in) :: &
@ -227,7 +223,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
integer :: &
instance, sourceOffset
instance = source_damage_isoBrittle_instance(phase)
@ -248,25 +244,25 @@ function source_damage_isoBrittle_postResults(phase, constituent)
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, &
source_damage_isoBrittle_instance(phase)))) :: &
source_damage_isoBrittle_postResults
integer(pInt) :: &
integer :: &
instance, sourceOffset, o, c
instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase)
c = 0_pInt
c = 0
do o = 1_pInt,size(param(instance)%outputID)
do o = 1,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_isoBrittle_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
c = c + 1
end select

48
src/source_damage_isoDuctile.f90
View File

@ -5,17 +5,15 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_damage_isoDuctile
use prec, only: &
pReal, &
pInt
use prec
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
integer, dimension(:), allocatable, public, protected :: &
source_damage_isoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_isoDuctile_instance !< instance of damage source mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
integer, dimension(:,:), allocatable, target, public :: &
source_damage_isoDuctile_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
@ -53,8 +51,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_init
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
@ -75,8 +71,8 @@ subroutine source_damage_isoDuctile_init
material_Nphase
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p,i
integer :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p,i
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
@ -89,13 +85,13 @@ subroutine source_damage_isoDuctile_init
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>'
Ninstance = count(phase_source == SOURCE_damage_isoDuctile_ID)
if (Ninstance == 0_pInt) return
if (Ninstance == 0) return
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)
allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt)
allocate(source_damage_isoDuctile_offset(material_Nphase), source=0)
allocate(source_damage_isoDuctile_instance(material_Nphase), source=0)
do phase = 1, material_Nphase
source_damage_isoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoDuctile_ID)
do source = 1, phase_Nsources(phase)
@ -104,7 +100,7 @@ subroutine source_damage_isoDuctile_init
enddo
enddo
allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance))
source_damage_isoDuctile_output = ''
@ -129,18 +125,18 @@ subroutine source_damage_isoDuctile_init
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')')
call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
do i=1, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('isoductile_drivingforce')
source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1_pInt
source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1
source_damage_isoDuctile_output(i,source_damage_isoDuctile_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
@ -155,7 +151,7 @@ subroutine source_damage_isoDuctile_init
instance = source_damage_isoDuctile_instance(phase)
sourceOffset = source_damage_isoDuctile_offset(phase)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
@ -176,11 +172,11 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
damage, &
damageMapping
integer(pInt), intent(in) :: &
integer, intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
integer(pInt) :: &
integer :: &
phase, constituent, instance, homog, sourceOffset, damageOffset
phase = phaseAt(ipc,ip,el)
@ -204,7 +200,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), intent(in) :: &
@ -212,7 +208,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
integer :: &
sourceOffset
sourceOffset = source_damage_isoDuctile_offset(phase)
@ -231,25 +227,25 @@ function source_damage_isoDuctile_postResults(phase, constituent)
use material, only: &
sourceState
integer(pInt), intent(in) :: &
integer, intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_isoDuctile_sizePostResult(:, &
source_damage_isoDuctile_instance(phase)))) :: &
source_damage_isoDuctile_postResults
integer(pInt) :: &
integer :: &
instance, sourceOffset, o, c
instance = source_damage_isoDuctile_instance(phase)
sourceOffset = source_damage_isoDuctile_offset(phase)
c = 0_pInt
c = 0
do o = 1_pInt,size(param(instance)%outputID)
do o = 1,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_isoDuctile_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
source_damage_isoDuctile_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
c = c + 1
end select

26
src/source_thermal_dissipation.f90
View File

@ -5,11 +5,14 @@
!> @details to be done
!--------------------------------------------------------------------------------------------------
module source_thermal_dissipation
use prec, only: &
pReal
use prec
use debug
use material
use config
implicit none
private
integer, dimension(:), allocatable, public, protected :: &
source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism?
source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism
@ -20,12 +23,12 @@ module source_thermal_dissipation
character(len=64), dimension(:,:), allocatable, target, public :: &
source_thermal_dissipation_output !< name of each post result output
type, private :: tParameters !< container type for internal constitutive parameters
type :: tParameters !< container type for internal constitutive parameters
real(pReal) :: &
kappa
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -40,21 +43,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_thermal_dissipation_init
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_thermal_dissipation_label, &
SOURCE_thermal_dissipation_ID, &
material_phase
use config, only: &
config_phase, &
material_Nphase
integer :: Ninstance,instance,source,sourceOffset
integer :: NofMyPhase,p

31
src/source_thermal_externalheat.f90
View File

@ -5,11 +5,14 @@
!> @brief material subroutine for variable heat source
!--------------------------------------------------------------------------------------------------
module source_thermal_externalheat
use prec, only: &
pReal
use prec
use debug
use material
use config
implicit none
private
integer, dimension(:), allocatable, public, protected :: &
source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism?
source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism
@ -23,7 +26,7 @@ module source_thermal_externalheat
integer, dimension(:), allocatable, target, public :: &
source_thermal_externalheat_Noutput !< number of outputs per instance of this source
type, private :: tParameters !< container type for internal constitutive parameters
type :: tParameters !< container type for internal constitutive parameters
real(pReal), dimension(:), allocatable :: &
time, &
heat_rate
@ -31,7 +34,7 @@ module source_thermal_externalheat
nIntervals
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -47,22 +50,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_thermal_externalheat_init
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use material, only: &
material_allocateSourceState, &
material_phase, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
SOURCE_thermal_externalheat_label, &
SOURCE_thermal_externalheat_ID
use config, only: &
config_phase, &
material_Nphase
integer :: maxNinstance,instance,source,sourceOffset,NofMyPhase,p
@ -116,8 +103,6 @@ end subroutine source_thermal_externalheat_init
!> @details state only contains current time to linearly interpolate given heat powers
!--------------------------------------------------------------------------------------------------
subroutine source_thermal_externalheat_dotState(phase, of)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &
@ -135,8 +120,6 @@ end subroutine source_thermal_externalheat_dotState
!> @brief returns local heat generation rate
!--------------------------------------------------------------------------------------------------
subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of)
use material, only: &
sourceState
integer, intent(in) :: &
phase, &

74
src/thermal_adiabatic.f90
View File

@ -3,8 +3,15 @@
!> @brief material subroutine for adiabatic temperature evolution
!--------------------------------------------------------------------------------------------------
module thermal_adiabatic
use prec, only: &
pReal
use prec
use config
use numerics
use material
use source_thermal_dissipation
use source_thermal_externalheat
use crystallite
use lattice
use mesh
implicit none
private
@ -21,7 +28,7 @@ module thermal_adiabatic
enumerator :: undefined_ID, &
temperature_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
integer(kind(undefined_ID)), dimension(:,:), allocatable :: &
thermal_adiabatic_outputID !< ID of each post result output
@ -41,21 +48,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine thermal_adiabatic_init
use material, only: &
thermal_type, &
thermal_typeInstance, &
homogenization_Noutput, &
THERMAL_ADIABATIC_label, &
THERMAL_adiabatic_ID, &
material_homogenizationAt, &
mappingHomogenization, &
thermalState, &
thermalMapping, &
thermal_initialT, &
temperature, &
temperatureRate
use config, only: &
config_homogenization
integer :: maxNinstance,section,instance,i,sizeState,NofMyHomog
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
@ -112,16 +104,6 @@ end subroutine thermal_adiabatic_init
!> @brief calculates adiabatic change in temperature based on local heat generation model
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_updateState(subdt, ip, el)
use numerics, only: &
err_thermal_tolAbs, &
err_thermal_tolRel
use material, only: &
material_homogenizationAt, &
mappingHomogenization, &
thermalState, &
temperature, &
temperatureRate, &
thermalMapping
integer, intent(in) :: &
ip, & !< integration point number
@ -156,28 +138,11 @@ function thermal_adiabatic_updateState(subdt, ip, el)
end function thermal_adiabatic_updateState
!--------------------------------------------------------------------------------------------------
!> @brief returns heat generation rate
!--------------------------------------------------------------------------------------------------
subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
use material, only: &
homogenization_Ngrains, &
material_homogenizationAt, &
mappingHomogenization, &
phaseAt, &
phasememberAt, &
thermal_typeInstance, &
phase_Nsources, &
phase_source, &
SOURCE_thermal_dissipation_ID, &
SOURCE_thermal_externalheat_ID
use source_thermal_dissipation, only: &
source_thermal_dissipation_getRateAndItsTangent
use source_thermal_externalheat, only: &
source_thermal_externalheat_getRateAndItsTangent
use crystallite, only: &
crystallite_S, &
crystallite_Lp
integer, intent(in) :: &
ip, & !< integration point number
@ -231,17 +196,11 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
end subroutine thermal_adiabatic_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized specific heat capacity
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_getSpecificHeat(ip,el)
use lattice, only: &
lattice_specificHeat
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
integer, intent(in) :: &
ip, & !< integration point number
@ -270,13 +229,6 @@ end function thermal_adiabatic_getSpecificHeat
!> @brief returns homogenized mass density
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_getMassDensity(ip,el)
use lattice, only: &
lattice_massDensity
use material, only: &
homogenization_Ngrains, &
material_phase
use mesh, only: &
mesh_element
integer, intent(in) :: &
ip, & !< integration point number
@ -304,8 +256,6 @@ end function thermal_adiabatic_getMassDensity
!> @brief return array of thermal results
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_postResults(homog,instance,of) result(postResults)
use material, only: &
temperature
integer, intent(in) :: &
homog, &