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

Merge remote-tracking branch 'origin/development' into signal_input_handling_1

This commit is contained in:
Martin Diehl 2021-01-17 16:52:48 +01:00
parent 0a3d43e0fc c32b904172
commit 8af53472ee
75 changed files with 4538 additions and 5127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
.gitlab-ci.yml
View File

@ -262,20 +262,6 @@ Pytest_grid:
- master
- release
Thermal:
stage: grid
script: Thermal/test.py
except:
- master
- release
Nonlocal_Damage_DetectChanges:
stage: grid
script: Nonlocal_Damage_DetectChanges/test.py
except:
- master
- release
Plasticity_DetectChanges:
stage: grid
script: Plasticity_DetectChanges/test.py

3
.gitmodules vendored
View File

@ -1,4 +1,5 @@
[submodule "PRIVATE"]
path = PRIVATE
path = PRIVATE
url = ../PRIVATE.git
branch = master
shallow = true

76
CMakeLists.txt
View File

@ -1,6 +1,18 @@
########################################################################################
# Compiler options for building DAMASK
cmake_minimum_required (VERSION 3.10.0 FATAL_ERROR)
cmake_minimum_required (VERSION 3.10.0)
include (FindPkgConfig REQUIRED)
# Dummy project to determine compiler names and version
project (Prerequisites LANGUAGES)
set(ENV{PKG_CONFIG_PATH} "$ENV{PETSC_DIR}/$ENV{PETSC_ARCH}/lib/pkgconfig")
pkg_check_modules (PETSC REQUIRED PETSc>=3.12.0 PETSc<3.15.0)
pkg_get_variable (CMAKE_Fortran_COMPILER PETSc fcompiler)
pkg_get_variable (CMAKE_C_COMPILER PETSc ccompiler)
find_program (CAT_EXECUTABLE NAMES cat)
execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION
RESULT_VARIABLE DAMASK_VERSION_RETURN
OUTPUT_VARIABLE DAMASK_VERSION
OUTPUT_STRIP_TRAILING_WHITESPACE)
#---------------------------------------------------------------------------------------
# Find PETSc from system environment
@ -28,19 +40,10 @@ include ${petsc_conf_rules}
include ${petsc_conf_variables}
INCLUDE_DIRS := \${PETSC_FC_INCLUDES}
LIBRARIES := \${PETSC_WITH_EXTERNAL_LIB}
COMPILERF := \${FC}
COMPILERC := \${CC}
LINKERNAME := \${FLINKER}
includes:
\t@echo \${INCLUDE_DIRS}
extlibs:
\t@echo \${LIBRARIES}
compilerf:
\t@echo \${COMPILERF}
compilerc:
\t@echo \${COMPILERC}
linker:
\t@echo \${LINKERNAME}
")
# CMake will execute each target in the ${petsc_config_makefile}
@ -52,26 +55,10 @@ execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_conf
OUTPUT_VARIABLE petsc_includes
OUTPUT_STRIP_TRAILING_WHITESPACE)
# Find the PETSc external linking directory settings
# required for final linking, must be appended after the executable
execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "extlibs"
RESULT_VARIABLE PETSC_EXTERNAL_LIB_RETURN
OUTPUT_VARIABLE petsc_external_lib
OUTPUT_STRIP_TRAILING_WHITESPACE)
# PETSc specified fortran compiler
execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerf"
RESULT_VARIABLE PETSC_MPIFC_RETURN
OUTPUT_VARIABLE PETSC_MPIFC
OUTPUT_STRIP_TRAILING_WHITESPACE)
# PETSc specified C compiler
execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerc"
RESULT_VARIABLE PETSC_MPICC_RETURN
OUTPUT_VARIABLE PETSC_MPICC
OUTPUT_STRIP_TRAILING_WHITESPACE)
# PETSc specified linker (Fortran compiler + PETSc linking flags)
execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "linker"
RESULT_VARIABLE PETSC_LINKER_RETURN
OUTPUT_VARIABLE PETSC_LINKER
OUTPUT_STRIP_TRAILING_WHITESPACE)
# Remove temporary makefile, no need to keep it anymore.
file (REMOVE_RECURSE ${TEMPDIR})
@ -90,14 +77,6 @@ endforeach (exlib)
message ("Found PETSC_DIR:\n${PETSC_DIR}\n" )
message ("Found PETSC_INCLUDES:\n${PETSC_INCLUDES}\n" )
message ("Found PETSC_EXTERNAL_LIB:\n${PETSC_EXTERNAL_LIB}\n")
message ("Found PETSC_LINKER:\n${PETSC_LINKER}\n" )
message ("Found MPI Fortran Compiler:\n${PETSC_MPIFC}\n" )
message ("Found MPI C Compiler:\n${PETSC_MPICC}\n" )
# set compiler commands to match PETSc (needs to be done before defining the project)
# https://cmake.org/Wiki/CMake_FAQ#How_do_I_use_a_different_compiler.3F
set (CMAKE_Fortran_COMPILER "${PETSC_MPIFC}")
set (CMAKE_C_COMPILER "${PETSC_MPICC}")
#---------------------------------------------------------------------------------------
# Now start to care about DAMASK
@ -105,17 +84,18 @@ set (CMAKE_C_COMPILER "${PETSC_MPICC}")
# DAMASK solver defines project to build
string(TOLOWER ${DAMASK_SOLVER} DAMASK_SOLVER)
if (DAMASK_SOLVER STREQUAL "grid")
project (damask-grid Fortran C)
project (damask-grid HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C)
add_definitions (-DGrid)
message ("Building Grid Solver\n")
elseif (DAMASK_SOLVER STREQUAL "mesh")
project (damask-mesh Fortran C)
project (damask-mesh HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C)
add_definitions (-DMesh)
message ("Building Mesh Solver\n")
else ()
message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined")
endif ()
list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
add_definitions (-DDAMASKVERSION="${DAMASK_VERSION}")
add_definitions (-DPETSc)
message ("\nBuilding ${CMAKE_PROJECT_NAME}\n")
if (CMAKE_BUILD_TYPE STREQUAL "")
set (CMAKE_BUILD_TYPE "RELEASE")
@ -153,17 +133,8 @@ if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only")
endif ()
# Parse DAMASK version from VERSION file
find_program (CAT_EXECUTABLE NAMES cat)
execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION
RESULT_VARIABLE DAMASK_VERSION_RETURN
OUTPUT_VARIABLE DAMASK_V
OUTPUT_STRIP_TRAILING_WHITESPACE)
add_definitions (-DDAMASKVERSION="${DAMASK_V}")
# definition of other macros
add_definitions (-DPETSc)
list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
include (Compiler-Intel)
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
@ -174,9 +145,8 @@ else ()
message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
endif ()
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}")
set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${PETSC_LINKER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${CMAKE_Fortran_COMPILER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
if (CMAKE_BUILD_TYPE STREQUAL "DEBUG")
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}")

2
LICENSE
View File

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

2
PRIVATE

@ -1 +1 @@
Subproject commit 08f8aea465a1b5e476b584bcae7927d113919b1d
Subproject commit b1a31a79cc90d458494068a96cfd3e9497aa330c

2
VERSION
View File

@ -1 +1 @@
v3.0.0-alpha2-26-gaad123f41
v3.0.0-alpha2-292-g589178668

2
cmake/Compiler-Intel.cmake
View File

@ -20,7 +20,7 @@ endif ()
# -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules
# (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172)
set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name")
set (STANDARD_CHECK "-stand f18 -standard-semantics -assume nostd_mod_proc_name")
set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel")
# Link against shared Intel libraries instead of static ones

2
examples/FEM/polyXtal/material.yaml
View File

@ -5,8 +5,8 @@ homogenization:
phase:
Aluminum:
lattice: cF
mechanics:
lattice: cF
output: [F, P, F_e, F_p, L_p]
elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke}
plasticity:

38
python/damask/_config.py
View File

@ -1,3 +1,4 @@
import copy
from io import StringIO
import abc
@ -21,6 +22,9 @@ class NiceDumper(yaml.SafeDumper):
return self.represent_data(dict(data)) if isinstance(data, dict) and type(data) != dict else \
super().represent_data(data)
def ignore_aliases(self, data):
"""No references."""
return True
class Config(dict):
"""YAML-based configuration."""
@ -32,6 +36,14 @@ class Config(dict):
output.seek(0)
return ''.join(output.readlines())
def __copy__(self):
"""Create deep copy."""
return copy.deepcopy(self)
copy = __copy__
@classmethod
def load(cls,fname):
"""
@ -49,6 +61,7 @@ class Config(dict):
fhandle = fname
return cls(yaml.safe_load(fhandle))
def save(self,fname,**kwargs):
"""
Save to yaml file.
@ -86,12 +99,37 @@ class Config(dict):
fhandle.write(yaml.dump(self,Dumper=NiceDumper,**kwargs))
def add(self,d):
"""
Add dictionary.
d : dict
Dictionary to append.
"""
duplicate = self.copy()
duplicate.update(d)
return duplicate
def delete(self,key):
"""
Delete item.
key : str or scalar
Label of the key to remove.
"""
duplicate = self.copy()
del duplicate[key]
return duplicate
@property
@abc.abstractmethod
def is_complete(self):
"""Check for completeness."""
pass
@property
@abc.abstractmethod
def is_valid(self):

24
python/damask/_configmaterial.py
View File

@ -1,5 +1,3 @@
import copy
import numpy as np
from . import Config
@ -9,6 +7,15 @@ from . import Orientation
class ConfigMaterial(Config):
"""Material configuration."""
_defaults = {'material': [],
'homogenization': {},
'phase': {}}
def __init__(self,d=_defaults):
"""Initialize object with default dictionary keys."""
super().__init__(d)
def save(self,fname='material.yaml',**kwargs):
"""
Save to yaml file.
@ -75,6 +82,8 @@ class ConfigMaterial(Config):
fraction: 1.0
phase: Steel
homogenization: SX
homogenization: {}
phase: {}
"""
constituents_ = {k:table.get(v) for k,v in constituents.items()}
@ -192,7 +201,7 @@ class ConfigMaterial(Config):
Limit renaming to selected constituents.
"""
dup = copy.deepcopy(self)
dup = self.copy()
for i,m in enumerate(dup['material']):
if ID and i not in ID: continue
for c in m['constituents']:
@ -216,7 +225,7 @@ class ConfigMaterial(Config):
Limit renaming to selected homogenization IDs.
"""
dup = copy.deepcopy(self)
dup = self.copy()
for i,m in enumerate(dup['material']):
if ID and i not in ID: continue
try:
@ -261,6 +270,8 @@ class ConfigMaterial(Config):
fraction: 1.0
phase: Aluminum
homogenization: SX
homogenization: {}
phase: {}
"""
length = -1
@ -274,7 +285,8 @@ class ConfigMaterial(Config):
c = [{} for _ in range(length)] if constituents is None else \
[{'constituents':u} for u in ConfigMaterial._constituents(**constituents)]
if len(c) == 1: c = [copy.deepcopy(c[0]) for _ in range(length)]
if len(c) == 1: c = [c[0] for _ in range(length)]
if length != 1 and length != len(c):
raise ValueError('Cannot add entries of different length')
@ -286,7 +298,7 @@ class ConfigMaterial(Config):
else:
for i in range(len(c)):
c[i][k] = v
dup = copy.deepcopy(self)
dup = self.copy()
dup['material'] = dup['material'] + c if 'material' in dup else c
return dup

30
python/damask/_grid.py
View File

@ -57,13 +57,10 @@ class Grid:
def __copy__(self):
"""Copy grid."""
"""Create deep copy."""
return copy.deepcopy(self)
def copy(self):
"""Copy grid."""
return self.__copy__()
copy = __copy__
def diff(self,other):
@ -766,24 +763,19 @@ class Grid:
if fill is None: fill = np.nanmax(self.material) + 1
dtype = float if np.isnan(fill) or int(fill) != fill or self.material.dtype==np.float else int
Eulers = R.as_Euler_angles(degrees=True)
material_in = self.material.copy()
material = self.material
# These rotations are always applied in the reference coordinate system, i.e. (z,x,z) not (z,x',z'')
# see https://www.cs.utexas.edu/~theshark/courses/cs354/lectures/cs354-14.pdf
for angle,axes in zip(Eulers[::-1], [(0,1),(1,2),(0,1)]):
material_out = ndimage.rotate(material_in,angle,axes,order=0,
prefilter=False,output=dtype,cval=fill)
if np.prod(material_in.shape) == np.prod(material_out.shape):
# avoid scipy interpolation errors for rotations close to multiples of 90°
material_in = np.rot90(material_in,k=np.rint(angle/90.).astype(int),axes=axes)
else:
material_in = material_out
for angle,axes in zip(R.as_Euler_angles(degrees=True)[::-1], [(0,1),(1,2),(0,1)]):
material_temp = ndimage.rotate(material,angle,axes,order=0,prefilter=False,output=dtype,cval=fill)
# avoid scipy interpolation errors for rotations close to multiples of 90°
material = material_temp if np.prod(material_temp.shape) != np.prod(material.shape) else \
np.rot90(material,k=np.rint(angle/90.).astype(int),axes=axes)
origin = self.origin-(np.asarray(material_in.shape)-self.cells)*.5 * self.size/self.cells
origin = self.origin-(np.asarray(material.shape)-self.cells)*.5 * self.size/self.cells
return Grid(material = material_in,
size = self.size/self.cells*np.asarray(material_in.shape),
return Grid(material = material,
size = self.size/self.cells*np.asarray(material.shape),
origin = origin,
comments = self.comments+[util.execution_stamp('Grid','rotate')],
)

46
python/damask/_orientation.py
View File

@ -199,7 +199,7 @@ class Orientation(Rotation):
def __copy__(self,**kwargs):
"""Copy."""
"""Create deep copy."""
return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion,
lattice =kwargs['lattice'] if 'lattice' in kwargs else self.lattice
if self.lattice is not None else self.family,
@ -225,30 +225,42 @@ class Orientation(Rotation):
Orientation to check for equality.
"""
return super().__eq__(other) \
and self.family == other.family \
and self.lattice == other.lattice \
and self.parameters == other.parameters
matching_type = all([hasattr(other,attr) and getattr(self,attr) == getattr(other,attr)
for attr in ['family','lattice','parameters']])
return np.logical_and(super().__eq__(other),matching_type)
def __matmul__(self,other):
def __ne__(self,other):
"""
Rotation of vector, second or fourth order tensor, or rotation object.
Not equal to other.
Parameters
----------
other : numpy.ndarray, Rotation, or Orientation
Vector, second or fourth order tensor, or rotation object that is rotated.
other : Orientation
Orientation to check for equality.
"""
return np.logical_not(self==other)
def __mul__(self,other):
"""
Compose this orientation with other.
Parameters
----------
other : Rotation or Orientation
Object for composition.
Returns
-------
other_rot : numpy.ndarray or Rotation
Rotated vector, second or fourth order tensor, or rotation object.
composition : Orientation
Compound rotation self*other, i.e. first other then self rotation.
"""
return self.copy(rotation=Rotation.__matmul__(self,Rotation(other.quaternion))) \
if isinstance(other,self.__class__) else \
Rotation.__matmul__(self,other)
if isinstance(other,Orientation) or isinstance(other,Rotation):
return self.copy(rotation=Rotation.__mul__(self,Rotation(other.quaternion)))
else:
raise TypeError('Use "O@b", i.e. matmul, to apply Orientation "O" to object "b"')
@classmethod
@ -429,7 +441,7 @@ class Orientation(Rotation):
raise ValueError('Missing crystal symmetry')
o = self.symmetry_operations.broadcast_to(self.symmetry_operations.shape+self.shape,mode='right')
return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left'))
return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left'))
@property
@ -608,7 +620,7 @@ class Orientation(Rotation):
o,lattice = self.relation_operations(model,return_lattice=True)
target = Orientation(lattice=lattice)
o = o.broadcast_to(o.shape+self.shape,mode='right')
return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left'),
return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left'),
lattice=lattice,
b = self.b if target.ratio['b'] is None else self.a*target.ratio['b'],
c = self.c if target.ratio['c'] is None else self.a*target.ratio['c'],

175
python/damask/_rotation.py
View File

@ -35,6 +35,11 @@ class Rotation:
- b = Q @ a
- b = np.dot(Q.as_matrix(),a)
Compound rotations R1 (first) and R2 (second):
- R = R2 * R1
- R = Rotation.from_matrix(np.dot(R2.as_matrix(),R1.as_matrix())
References
----------
D. Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015
@ -65,22 +70,13 @@ class Rotation:
def __repr__(self):
"""Represent rotation as unit quaternion, rotation matrix, and Bunge-Euler angles."""
if self == Rotation():
return 'Rotation()'
else:
return f'Quaternions {self.shape}:\n'+str(self.quaternion) \
if self.quaternion.shape != (4,) else \
'\n'.join([
'Quaternion: (real={:.3f}, imag=<{:+.3f}, {:+.3f}, {:+.3f}>)'.format(*(self.quaternion)),
'Matrix:\n{}'.format(np.round(self.as_matrix(),8)),
'Bunge Eulers / deg: ({:3.2f}, {:3.2f}, {:3.2f})'.format(*self.as_Euler_angles(degrees=True)),
])
"""Represent rotation as unit quaternion(s)."""
return f'Quaternion{" " if self.quaternion.shape == (4,) else "s of shape "+str(self.quaternion.shape)+chr(10)}'\
+ str(self.quaternion)
# ToDo: Check difference __copy__ vs __deepcopy__
def __copy__(self,**kwargs):
"""Copy."""
"""Create deep copy."""
return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion)
copy = __copy__
@ -97,6 +93,26 @@ class Rotation:
"""
Equal to other.
Equality is determined taking limited floating point precision into account.
See numpy.allclose for details.
Parameters
----------
other : Rotation
Rotation to check for equality.
"""
s = self.quaternion
o = other.quaternion
if self.shape == () == other.shape:
return np.allclose(s,o) or (np.isclose(s[0],0.0) and np.allclose(s,-1.0*o))
else:
return np.all(np.isclose(s,o),-1) + np.all(np.isclose(s,-1.0*o),-1) * np.isclose(s[...,0],0.0)
def __ne__(self,other):
"""
Not equal to other.
Equality is determined taking limited floating point precision into
account. See numpy.allclose for details.
@ -106,8 +122,7 @@ class Rotation:
Rotation to check for equality.
"""
return np.prod(self.shape,dtype=int) == np.prod(other.shape,dtype=int) \
and np.allclose(self.quaternion,other.quaternion)
return np.logical_not(self==other)
@property
@ -127,36 +142,46 @@ class Rotation:
return dup
def __pow__(self,pwr):
def __pow__(self,exp):
"""
Raise quaternion to power.
Equivalent to performing the rotation 'pwr' times.
Perform the rotation 'exp' times.
Parameters
----------
pwr : float
Power to raise quaternion to.
exp : float
Exponent.
"""
phi = np.arccos(self.quaternion[...,0:1])
p = self.quaternion[...,1:]/np.linalg.norm(self.quaternion[...,1:],axis=-1,keepdims=True)
return self.copy(rotation=Rotation(np.block([np.cos(pwr*phi),np.sin(pwr*phi)*p]))._standardize())
return self.copy(rotation=Rotation(np.block([np.cos(exp*phi),np.sin(exp*phi)*p]))._standardize())
def __matmul__(self,other):
def __ipow__(self,exp):
"""
Rotation of vector, second or fourth order tensor, or rotation object.
Perform the rotation 'exp' times (in-place).
Parameters
----------
other : numpy.ndarray or Rotation
Vector, second or fourth order tensor, or rotation object that is rotated.
exp : float
Exponent.
"""
return self**exp
def __mul__(self,other):
"""
Compose this rotation with other.
Parameters
----------
other : Rotation of shape(self.shape)
Rotation for composition.
Returns
-------
other_rot : numpy.ndarray or Rotation
Rotated vector, second or fourth order tensor, or rotation object.
composition : Rotation
Compound rotation self*other, i.e. first other then self rotation.
"""
if isinstance(other,Rotation):
@ -167,8 +192,71 @@ class Rotation:
q = (q_m*q_o - np.einsum('...i,...i',p_m,p_o).reshape(self.shape+(1,)))
p = q_m*p_o + q_o*p_m + _P * np.cross(p_m,p_o)
return Rotation(np.block([q,p]))._standardize()
else:
raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"')
elif isinstance(other,np.ndarray):
def __imul__(self,other):
"""
Compose this rotation with other (in-place).
Parameters
----------
other : Rotation of shape(self.shape)
Rotation for composition.
"""
return self*other
def __truediv__(self,other):
"""
Compose this rotation with inverse of other.
Parameters
----------
other : damask.Rotation of shape (self.shape)
Rotation to inverse composition.
Returns
-------
composition : Rotation
Compound rotation self*(~other), i.e. first inverse of other then self rotation.
"""
if isinstance(other,Rotation):
return self*~other
else:
raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"')
def __itruediv__(self,other):
"""
Compose this rotation with inverse of other (in-place).
Parameters
----------
other : Rotation of shape (self.shape)
Rotation to inverse composition.
"""
return self/other
def __matmul__(self,other):
"""
Rotation of vector, second order tensor, or fourth order tensor.
Parameters
----------
other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3)
Vector or tensor on which to apply the rotation.
Returns
-------
rotated : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3)
Rotated vector or tensor, i.e. transformed to frame defined by rotation.
"""
if isinstance(other,np.ndarray):
if self.shape + (3,) == other.shape:
q_m = self.quaternion[...,0]
p_m = self.quaternion[...,1:]
@ -188,9 +276,13 @@ class Rotation:
return np.einsum('...im,...jn,...ko,...lp,...mnop',R,R,R,R,other)
else:
raise ValueError('Can only rotate vectors, 2nd order tensors, and 4th order tensors')
elif isinstance(other,Rotation):
raise TypeError('Use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"')
else:
raise TypeError(f'Cannot rotate {type(other)}')
apply = __matmul__
def _standardize(self):
"""Standardize quaternion (ensure positive real hemisphere)."""
@ -199,8 +291,16 @@ class Rotation:
def append(self,other):
"""Extend rotation array along first dimension with other array."""
return self.copy(rotation=np.vstack((self.quaternion,other.quaternion)))
"""
Extend rotation array along first dimension with other array(s).
Parameters
----------
other : Rotation or list of Rotations.
"""
return self.copy(rotation=np.vstack(tuple(map(lambda x:x.quaternion,
[self]+other if isinstance(other,list) else [self,other]))))
def flatten(self,order = 'C'):
@ -258,7 +358,7 @@ class Rotation:
"""Intermediate representation supporting quaternion averaging."""
return np.einsum('...i,...j',quat,quat)
if not weights:
if weights is None:
weights = np.ones(self.shape,dtype=float)
eig, vec = np.linalg.eig(np.sum(_M(self.quaternion) * weights[...,np.newaxis,np.newaxis],axis=-3) \
@ -283,7 +383,7 @@ class Rotation:
Rotation to which the misorientation is computed.
"""
return other@~self
return other*~self
################################################################################################
@ -806,7 +906,7 @@ class Rotation:
np.sqrt(1-u**2)*np.sin(Theta),
u, omega])
return Rotation.from_axis_angle(p) @ center
return Rotation.from_axis_angle(p) * center
@staticmethod
@ -857,8 +957,8 @@ class Rotation:
f[::2,:3] *= -1 # flip half the rotation axes to negative sense
return R_align.broadcast_to(N) \
@ Rotation.from_axis_angle(p,normalize=True) \
@ Rotation.from_axis_angle(f)
* Rotation.from_axis_angle(p,normalize=True) \
* Rotation.from_axis_angle(f)
####################################################################################################
@ -1047,7 +1147,6 @@ class Rotation:
@staticmethod
def _om2ax(om):
"""Rotation matrix to axis angle pair."""
#return Rotation._qu2ax(Rotation._om2qu(om)) # HOTFIX
diag_delta = -_P*np.block([om[...,1,2:3]-om[...,2,1:2],
om[...,2,0:1]-om[...,0,2:3],
om[...,0,1:2]-om[...,1,0:1]

6
python/damask/_table.py
View File

@ -42,12 +42,10 @@ class Table:
return len(self.data)
def __copy__(self):
"""Copy Table."""
"""Create deep copy."""
return copy.deepcopy(self)
def copy(self):
"""Copy Table."""
return self.__copy__()
copy = __copy__
def _label_discrete(self):

4
python/damask/grid_filters.py
View File

@ -234,7 +234,7 @@ def cellsSizeOrigin_coordinates0_point(coordinates0,ordered=True):
origin[_np.where(cells==1)] = 0.0
if cells.prod() != len(coordinates0):
raise ValueError('Data count {len(coordinates0)} does not match cells {cells}.')
raise ValueError(f'Data count {len(coordinates0)} does not match cells {cells}.')
start = origin + delta*.5
end = origin - delta*.5 + size
@ -387,7 +387,7 @@ def cellsSizeOrigin_coordinates0_node(coordinates0,ordered=True):
origin = mincorner
if (cells+1).prod() != len(coordinates0):
raise ValueError('Data count {len(coordinates0)} does not match cells {cells}.')
raise ValueError(f'Data count {len(coordinates0)} does not match cells {cells}.')
atol = _np.max(size)*5e-2
if not (_np.allclose(coords[0],_np.linspace(mincorner[0],maxcorner[0],cells[0]+1),atol=atol) and \

10
python/tests/reference/ConfigMaterial/material.yaml
View File

@ -1,10 +1,10 @@
homogenization:
SX:
N_constituents: 2
mech: {type: none}
N_constituents: 1
mechanics: {type: none}
Taylor:
N_constituents: 2
mech: {type: isostrain}
mechanics: {type: isostrain}
material:
- constituents:
@ -34,11 +34,11 @@ material:
phase:
Aluminum:
lattice: cF
mech:
mechanics:
output: [F, P, F_e, F_p, L_p]
elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke}
Steel:
lattice: cI
mech:
mechanics:
output: [F, P, F_e, F_p, L_p]
elasticity: {C_11: 233.3e9, C_12: 135.5e9, C_44: 118.0e9, type: hooke}

4
python/tests/test_Config.py
View File

@ -22,6 +22,10 @@ class TestConfig:
with open(tmp_path/'config.yaml') as f:
assert Config.load(f) == config
def test_add_remove(self):
config = Config()
assert config.add({'hello':'world'}).delete('hello') == config
def test_repr(self,tmp_path):
config = Config()
config['A'] = 1

9
python/tests/test_Orientation.py
View File

@ -25,13 +25,16 @@ class TestOrientation:
@pytest.mark.parametrize('shape',[None,5,(4,6)])
def test_equal(self,lattice,shape):
R = Rotation.from_random(shape)
assert Orientation(R,lattice) == Orientation(R,lattice)
assert Orientation(R,lattice) == Orientation(R,lattice) if shape is None else \
(Orientation(R,lattice) == Orientation(R,lattice)).all()
@pytest.mark.parametrize('lattice',Orientation.crystal_families)
@pytest.mark.parametrize('shape',[None,5,(4,6)])
def test_unequal(self,lattice,shape):
R = Rotation.from_random(shape)
assert not(Orientation(R,lattice) != Orientation(R,lattice))
assert not ( Orientation(R,lattice) != Orientation(R,lattice) if shape is None else \
(Orientation(R,lattice) != Orientation(R,lattice)).any())
@pytest.mark.parametrize('a,b',[
(dict(rotation=[1,0,0,0]),
@ -403,7 +406,7 @@ class TestOrientation:
def test_relationship_vectorize(self,set_of_quaternions,lattice,model):
r = Orientation(rotation=set_of_quaternions[:200].reshape((50,4,4)),lattice=lattice).related(model)
for i in range(200):
assert r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model)
assert (r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model)).all()
@pytest.mark.parametrize('model',['Bain','KS','GT','GT_prime','NW','Pitsch'])
@pytest.mark.parametrize('lattice',['cF','cI'])

87
python/tests/test_Rotation.py
View File

@ -526,7 +526,7 @@ class TestRotation:
o = backward(forward(m))
u = np.array([np.pi*2,np.pi,np.pi*2])
ok = np.allclose(m,o,atol=atol)
ok = ok or np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol)
ok |= np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol)
if np.isclose(m[1],0.0,atol=atol) or np.isclose(m[1],np.pi,atol=atol):
sum_phi = np.unwrap([m[0]+m[2],o[0]+o[2]])
ok |= np.isclose(sum_phi[0],sum_phi[1],atol=atol)
@ -550,19 +550,22 @@ class TestRotation:
assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}'
@pytest.mark.parametrize('forward,backward',[(Rotation._ro2qu,Rotation._qu2ro),
#(Rotation._ro2om,Rotation._om2ro),
#(Rotation._ro2eu,Rotation._eu2ro),
(Rotation._ro2om,Rotation._om2ro),
(Rotation._ro2eu,Rotation._eu2ro),
(Rotation._ro2ax,Rotation._ax2ro),
(Rotation._ro2ho,Rotation._ho2ro),
(Rotation._ro2cu,Rotation._cu2ro)])
def test_Rodrigues_internal(self,set_of_rotations,forward,backward):
"""Ensure invariance of conversion from Rodrigues-Frank vector and back."""
cutoff = np.tan(np.pi*.5*(1.-1e-4))
cutoff = np.tan(np.pi*.5*(1.-1e-5))
for rot in set_of_rotations:
m = rot.as_Rodrigues_vector()
o = backward(forward(m))
ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol)
ok = ok or np.isclose(m[3],0.0,atol=atol)
ok |= np.isclose(m[3],0.0,atol=atol)
if m[3] > cutoff:
ok |= np.allclose(m[:3],-1*o[:3])
assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}'
@pytest.mark.parametrize('forward,backward',[(Rotation._ho2qu,Rotation._qu2ho),
@ -592,7 +595,7 @@ class TestRotation:
o = backward(forward(m))
ok = np.allclose(m,o,atol=atol)
if np.count_nonzero(np.isclose(np.abs(o),np.pi**(2./3.)*.5)):
ok = ok or np.allclose(m*-1.,o,atol=atol)
ok |= np.allclose(m*-1.,o,atol=atol)
assert ok and np.max(np.abs(o)) < np.pi**(2./3.) * 0.5 + 1.e-9, f'{m},{o},{rot.as_quaternion()}'
@pytest.mark.parametrize('vectorized, single',[(Rotation._qu2om,qu2om),
@ -719,7 +722,7 @@ class TestRotation:
o = Rotation.from_axis_angle(rot.as_axis_angle()).as_axis_angle()
ok = np.allclose(m,o,atol=atol)
if np.isclose(m[3],np.pi,atol=atol):
ok = ok or np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol)
ok |= np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol)
assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) \
and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}'
@ -740,7 +743,7 @@ class TestRotation:
m = rot.as_Rodrigues_vector()
o = Rotation.from_homochoric(rot.as_homochoric()*P*-1,P).as_Rodrigues_vector()
ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol)
ok = ok or np.isclose(m[3],0.0,atol=atol)
ok |= np.isclose(m[3],0.0,atol=atol)
assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}'
@pytest.mark.parametrize('P',[1,-1])
@ -780,8 +783,22 @@ class TestRotation:
else:
assert r.shape == shape
def test_equal(self):
assert Rotation.from_random(rng_seed=1) == Rotation.from_random(rng_seed=1)
@pytest.mark.parametrize('shape',[None,5,(4,6)])
def test_equal(self,shape):
R = Rotation.from_random(shape,rng_seed=1)
assert R == R if shape is None else (R == R).all()
@pytest.mark.parametrize('shape',[None,5,(4,6)])
def test_unequal(self,shape):
R = Rotation.from_random(shape,rng_seed=1)
assert not (R != R if shape is None else (R != R).any())
def test_equal_ambiguous(self):
qu = np.random.rand(10,4)
qu[:,0] = 0.
qu/=np.linalg.norm(qu,axis=1,keepdims=True)
assert (Rotation(qu) == Rotation(-qu)).all()
def test_inversion(self):
r = Rotation.from_random()
@ -798,7 +815,15 @@ class TestRotation:
p = Rotation.from_random(shape=shape)
s = r.append(p)
print(f'append 2x {shape} --> {s.shape}')
assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...]
assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all()
@pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(3,3,2)])
def test_append_list(self,shape):
r = Rotation.from_random(shape=shape)
p = Rotation.from_random(shape=shape)
s = r.append([r,p])
print(f'append 3x {shape} --> {s.shape}')
assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all()
@pytest.mark.parametrize('quat,standardized',[
([-1,0,0,0],[1,0,0,0]),
@ -820,7 +845,7 @@ class TestRotation:
@pytest.mark.parametrize('order',['C','F'])
def test_flatten_reshape(self,shape,order):
r = Rotation.from_random(shape=shape)
assert r == r.flatten(order).reshape(shape,order)
assert (r == r.flatten(order).reshape(shape,order)).all()
@pytest.mark.parametrize('function',[Rotation.from_quaternion,
Rotation.from_Euler_angles,
@ -931,7 +956,7 @@ class TestRotation:
def test_rotate_inverse(self):
R = Rotation.from_random()
assert np.allclose(np.eye(3),(~R@R).as_matrix())
assert np.allclose(np.eye(3),(~R*R).as_matrix())
@pytest.mark.parametrize('data',[np.random.rand(3),
np.random.rand(3,3),
@ -965,6 +990,42 @@ class TestRotation:
R_2 = Rotation.from_Euler_angles([360,0,0],degrees=True)
assert np.allclose(R_1.misorientation(R_2).as_matrix(),np.eye(3))
def test_composition(self):
a,b = (Rotation.from_random(),Rotation.from_random())
c = a * b
a *= b
assert c == a
def test_composition_invalid(self):
with pytest.raises(TypeError):
Rotation()*np.ones(3)
def test_composition_inverse(self):
a,b = (Rotation.from_random(),Rotation.from_random())
c = a / b
a /= b
assert c == a
def test_composition_inverse_invalid(self):
with pytest.raises(TypeError):
Rotation()/np.ones(3)
def test_power(self):
a = Rotation.from_random()
r = (np.random.rand()-.5)*4
b = a**r
a **= r
assert a == b
def test_invariant(self):
R = Rotation.from_random()
assert R/R == R*R**(-1) == Rotation()
@pytest.mark.parametrize('item',[np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))])
def test_apply(self,item):
r = Rotation.from_random()
assert (r.apply(item) == r@item).all()
@pytest.mark.parametrize('angle',[10,20,30,40,50,60,70,80,90,100,120])
def test_average(self,angle):
R = Rotation.from_axis_angle([[0,0,1,10],[0,0,1,angle]],degrees=True)

2
python/tests/test_Table.py
View File

@ -22,7 +22,7 @@ class TestTable:
@pytest.mark.parametrize('N',[10,40])
def test_len(self,N):
len(Table(np.random.rand(N,3),{'X':3})) == N
assert len(Table(np.random.rand(N,3),{'X':3})) == N
def test_get_scalar(self,default):
d = default.get('s')

32
src/CPFEM.f90
View File

@ -5,7 +5,6 @@
!--------------------------------------------------------------------------------------------------
module CPFEM
use prec
use FEsolving
use math
use rotations
use YAML_types
@ -13,7 +12,6 @@ module CPFEM
use discretization_marc
use material
use config
use crystallite
use homogenization
use IO
use discretization
@ -89,8 +87,8 @@ subroutine CPFEM_initAll
call lattice_init
call material_init(.false.)
call constitutive_init
call crystallite_init
call homogenization_init
call crystallite_init
call CPFEM_init
call config_deallocate
@ -153,7 +151,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
H
integer(pInt) elCP, & ! crystal plasticity element number
i, j, k, l, m, n, ph, homog, mySource
i, j, k, l, m, n, ph, homog, mySource,ma
real(pReal), parameter :: ODD_STRESS = 1e15_pReal, & !< return value for stress if terminallyIll
ODD_JACOBIAN = 1e50_pReal !< return value for jacobian if terminallyIll
@ -161,6 +159,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
elCP = mesh_FEM2DAMASK_elem(elFE)
ma = (elCP-1) * discretization_nIPs + ip
if (debugCPFEM%basic .and. elCP == debugCPFEM%element .and. ip == debugCPFEM%ip) then
print'(/,a)', '#############################################'
print'(a1,a22,1x,i8,a13)', '#','element', elCP, '#'
@ -181,11 +181,11 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP)))
case (THERMAL_conduction_ID) chosenThermal1
temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
temperature(material_homogenizationAt(elCP))%p(material_homogenizationMemberAt(ip,elCP)) = &
temperature_inp
end select chosenThermal1
homogenization_F0(1:3,1:3,ip,elCP) = ffn
homogenization_F(1:3,1:3,ip,elCP) = ffn1
homogenization_F0(1:3,1:3,ma) = ffn
homogenization_F(1:3,1:3,ma) = ffn1
if (iand(mode, CPFEM_CALCRESULTS) /= 0_pInt) then
@ -196,11 +196,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
CPFEM_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6)
else validCalculation
FEsolving_execElem = elCP
FEsolving_execIP = ip
if (debugCPFEM%extensive) &
print'(a,i8,1x,i2)', '<< CPFEM >> calculation for elFE ip ',elFE,ip
call materialpoint_stressAndItsTangent(dt)
call materialpoint_stressAndItsTangent(dt,[ip,ip],[elCP,elCP])
terminalIllness: if (terminallyIll) then
@ -212,17 +210,17 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
else terminalIllness
! translate from P to sigma
Kirchhoff = matmul(homogenization_P(1:3,1:3,ip,elCP), transpose(homogenization_F(1:3,1:3,ip,elCP)))
J_inverse = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ip,elCP))
Kirchhoff = matmul(homogenization_P(1:3,1:3,ma), transpose(homogenization_F(1:3,1:3,ma)))
J_inverse = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ma))
CPFEM_cs(1:6,ip,elCP) = math_sym33to6(J_inverse * Kirchhoff,weighted=.false.)
! translate from dP/dF to dCS/dE
H = 0.0_pReal
do i=1,3; do j=1,3; do k=1,3; do l=1,3; do m=1,3; do n=1,3
H(i,j,k,l) = H(i,j,k,l) &
+ homogenization_F(j,m,ip,elCP) * homogenization_F(l,n,ip,elCP) &
* homogenization_dPdF(i,m,k,n,ip,elCP) &
- math_delta(j,l) * homogenization_F(i,m,ip,elCP) * homogenization_P(k,m,ip,elCP) &
+ homogenization_F(j,m,ma) * homogenization_F(l,n,ma) &
* homogenization_dPdF(i,m,k,n,ma) &
- math_delta(j,l) * homogenization_F(i,m,ma) * homogenization_P(k,m,ma) &
+ 0.5_pReal * ( Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
+ Kirchhoff(j,k)*math_delta(i,l) + Kirchhoff(i,l)*math_delta(j,k))
enddo; enddo; enddo; enddo; enddo; enddo
@ -259,7 +257,8 @@ end subroutine CPFEM_general
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_forward
call crystallite_forward
call homogenization_forward
call constitutive_forward
end subroutine CPFEM_forward
@ -275,7 +274,6 @@ subroutine CPFEM_results(inc,time)
call results_openJobFile
call results_addIncrement(inc,time)
call constitutive_results
call crystallite_results
call homogenization_results
call discretization_results
call results_finalizeIncrement

38
src/CPFEM2.f90
View File

@ -6,7 +6,6 @@
module CPFEM2
use prec
use config
use FEsolving
use math
use rotations
use YAML_types
@ -21,7 +20,6 @@ module CPFEM2
use HDF5_utilities
use homogenization
use constitutive
use crystallite
#if defined(Mesh)
use FEM_quadrature
use discretization_mesh
@ -63,8 +61,8 @@ subroutine CPFEM_initAll
#endif
call material_init(restart=interface_restartInc>0)
call constitutive_init
call crystallite_init
call homogenization_init
call crystallite_init
call CPFEM_init
call config_deallocate
@ -76,9 +74,23 @@ end subroutine CPFEM_initAll
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_init
integer(HID_T) :: fileHandle
character(len=pStringLen) :: fileName
print'(/,a)', ' <<<+- CPFEM init -+>>>'; flush(IO_STDOUT)
if (interface_restartInc > 0) call crystallite_restartRead
if (interface_restartInc > 0) then
print'(/,a,i0,a)', ' reading restart information of increment from file'; flush(IO_STDOUT)
write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName)
call homogenization_restartRead(fileHandle)
call constitutive_restartRead(fileHandle)
call HDF5_closeFile(fileHandle)
endif
end subroutine CPFEM_init
@ -88,7 +100,19 @@ end subroutine CPFEM_init
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_restartWrite
call crystallite_restartWrite
integer(HID_T) :: fileHandle
character(len=pStringLen) :: fileName
print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT)
write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName,'a')
call homogenization_restartWrite(fileHandle)
call constitutive_restartWrite(fileHandle)
call HDF5_closeFile(fileHandle)
end subroutine CPFEM_restartWrite
@ -98,7 +122,8 @@ end subroutine CPFEM_restartWrite
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_forward
call crystallite_forward
call homogenization_forward
call constitutive_forward
end subroutine CPFEM_forward
@ -114,7 +139,6 @@ subroutine CPFEM_results(inc,time)
call results_openJobFile
call results_addIncrement(inc,time)
call constitutive_results
call crystallite_results
call homogenization_results
call discretization_results
call results_finalizeIncrement

2
src/C_routines.c
View File

@ -43,7 +43,7 @@ void gethostname_c(char hostname[], int *stat){
void getusername_c(char username[], int *stat){
struct passwd *pw = getpwuid(geteuid());
struct passwd *pw = getpwuid(getuid());
if(pw && strlen(pw->pw_name) <= STRLEN){
strncpy(username,pw->pw_name,STRLEN+1);
*stat = 0;

14
src/DAMASK_interface.f90
View File

@ -10,7 +10,7 @@
!> and working directory.
!--------------------------------------------------------------------------------------------------
#define PETSC_MAJOR 3
#define PETSC_MINOR_MIN 10
#define PETSC_MINOR_MIN 12
#define PETSC_MINOR_MAX 14
module DAMASK_interface
@ -54,12 +54,6 @@ subroutine DAMASK_interface_init
===================================================================================================
-- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION --
===================================================================================================
============ THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION ========================
=============== THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION =====================
================== THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION ==================
===================================================================================================
-- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION --
===================================================================================================
#endif
character(len=pPathLen*3+pStringLen) :: &
@ -392,7 +386,7 @@ end function makeRelativePath
subroutine catchSIGTERM(signal) bind(C)
integer(C_INT), value :: signal
interface_SIGTERM = .true.
call interface_setSIGTERM(.true.)
print'(a,i0,a)', ' received signal ',signal, ', set SIGTERM=TRUE'
@ -417,7 +411,7 @@ end subroutine interface_setSIGTERM
subroutine catchSIGUSR1(signal) bind(C)
integer(C_INT), value :: signal
interface_SIGUSR1 = .true.
call interface_setSIGUSR1(.true.)
print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR1=TRUE'
@ -442,7 +436,7 @@ end subroutine interface_setSIGUSR1
subroutine catchSIGUSR2(signal) bind(C)
integer(C_INT), value :: signal
interface_SIGUSR2 = .true.
call interface_setSIGUSR2(.true.)
print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR2=TRUE'

4
src/DAMASK_marc.f90
View File

@ -176,7 +176,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
use DAMASK_interface
use config
use YAML_types
use FEsolving
use discretization_marc
use homogenization
use CPFEM
@ -365,7 +364,8 @@ subroutine flux(f,ts,n,time)
real(pReal), dimension(2), intent(out) :: &
f
call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1)))
f(2) = 0.0_pReal
call thermal_conduction_getSource(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1)))
end subroutine flux

15
src/FEsolving.f90
View File

@ -1,15 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief global variables for flow control
!--------------------------------------------------------------------------------------------------
module FEsolving
implicit none
public
integer, dimension(2) :: &
FEsolving_execElem, & !< for ping-pong scheme always whole range, otherwise one specific element
FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP
end module FEsolving

11
src/commercialFEM_fileList.f90
View File

@ -11,9 +11,7 @@
#include "config.f90"
#include "LAPACK_interface.f90"
#include "math.f90"
#include "quaternions.f90"
#include "rotations.f90"
#include "FEsolving.f90"
#include "element.f90"
#include "HDF5_utilities.f90"
#include "results.f90"
@ -34,8 +32,8 @@
#include "constitutive_plastic_disloTungsten.f90"
#include "constitutive_plastic_nonlocal.f90"
#include "constitutive_thermal.f90"
#include "source_thermal_dissipation.f90"
#include "source_thermal_externalheat.f90"
#include "constitutive_thermal_dissipation.f90"
#include "constitutive_thermal_externalheat.f90"
#include "kinematics_thermal_expansion.f90"
#include "constitutive_damage.f90"
#include "source_damage_isoBrittle.f90"
@ -44,15 +42,14 @@
#include "source_damage_anisoDuctile.f90"
#include "kinematics_cleavage_opening.f90"
#include "kinematics_slipplane_opening.f90"
#include "crystallite.f90"
#include "thermal_isothermal.f90"
#include "thermal_adiabatic.f90"
#include "thermal_conduction.f90"
#include "damage_none.f90"
#include "damage_local.f90"
#include "damage_nonlocal.f90"
#include "homogenization.f90"
#include "homogenization_mech.f90"
#include "homogenization_mech_none.f90"
#include "homogenization_mech_isostrain.f90"
#include "homogenization_mech_RGC.f90"
#include "homogenization_thermal.f90"
#include "CPFEM.f90"

1174
src/constitutive.f90
View File

File diff suppressed because it is too large Load Diff

323
src/constitutive_damage.f90
View File

@ -1,14 +1,24 @@
!----------------------------------------------------------------------------------------------------
!> @brief internal microstructure state for all damage sources and kinematics constitutive models
!> @brief internal microstructure state for all damage sources and kinematics constitutive models
!----------------------------------------------------------------------------------------------------
submodule(constitutive) constitutive_damage
enum, bind(c); enumerator :: &
DAMAGE_UNDEFINED_ID, &
DAMAGE_ISOBRITTLE_ID, &
DAMAGE_ISODUCTILE_ID, &
DAMAGE_ANISOBRITTLE_ID, &
DAMAGE_ANISODUCTILE_ID
end enum
integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:,:), allocatable :: &
phase_source !< active sources mechanisms of each phase
interface
module function source_damage_anisoBrittle_init(source_length) result(mySources)
integer, intent(in) :: source_length
logical, dimension(:,:), allocatable :: mySources
end function source_damage_anisoBrittle_init
end function source_damage_anisoBrittle_init
module function source_damage_anisoDuctile_init(source_length) result(mySources)
integer, intent(in) :: source_length
@ -23,7 +33,7 @@ submodule(constitutive) constitutive_damage
module function source_damage_isoDuctile_init(source_length) result(mySources)
integer, intent(in) :: source_length
logical, dimension(:,:), allocatable :: mySources
end function source_damage_isoDuctile_init
end function source_damage_isoDuctile_init
module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics)
integer, intent(in) :: kinematics_length
@ -39,14 +49,14 @@ submodule(constitutive) constitutive_damage
module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
integer, intent(in) :: &
phase, & !< phase ID of element
constituent !< position of element within its phase instance
constituent !< position of element within its phase instance
real(pReal), intent(in) :: &
phi !< damage parameter
phi !< damage parameter
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
end subroutine source_damage_anisoBrittle_getRateAndItsTangent
module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
integer, intent(in) :: &
phase, & !< phase ID of element
@ -119,41 +129,41 @@ module subroutine damage_init
phases => config_material%get('phase')
allocate(sourceState (phases%length))
allocate(damageState (phases%length))
allocate(phase_Nsources(phases%length),source = 0) ! same for kinematics
do ph = 1,phases%length
phase => phases%get(ph)
sources => phase%get('source',defaultVal=emptyList)
phase_Nsources(ph) = sources%length
allocate(sourceState(ph)%p(phase_Nsources(ph)))
allocate(damageState(ph)%p(phase_Nsources(ph)))
enddo
allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID)
allocate(phase_source(maxval(phase_Nsources),phases%length), source = DAMAGE_UNDEFINED_ID)
! initialize source mechanisms
if(maxval(phase_Nsources) /= 0) then
where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoBrittle_ID
where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoDuctile_ID
where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoBrittle_ID
where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoDuctile_ID
where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISOBRITTLE_ID
where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISODUCTILE_ID
where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISOBRITTLE_ID
where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISODUCTILE_ID
endif
!--------------------------------------------------------------------------------------------------
! initialize kinematic mechanisms
allocate(phase_Nkinematics(phases%length),source = 0)
allocate(phase_Nkinematics(phases%length),source = 0)
do ph = 1,phases%length
phase => phases%get(ph)
kinematics => phase%get('kinematics',defaultVal=emptyList)
phase_Nkinematics(ph) = kinematics%length
enddo
allocate(phase_kinematics(maxval(phase_Nkinematics),phases%length), source = KINEMATICS_undefined_ID)
allocate(phase_kinematics(maxval(phase_Nkinematics),phases%length), source = KINEMATICS_undefined_ID)
if(maxval(phase_Nkinematics) /= 0) then
where(kinematics_cleavage_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_cleavage_opening_ID
where(kinematics_slipplane_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_slipplane_opening_ID
endif
endif
end subroutine damage_init
@ -167,7 +177,7 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
phi !< damage parameter
phi !< damage parameter
real(pReal), intent(inout) :: &
phiDot, &
dPhiDot_dPhi
@ -183,22 +193,22 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi
phiDot = 0.0_pReal
dPhiDot_dPhi = 0.0_pReal
do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
phase = material_phaseAt(grain,el)
constituent = material_phasememberAt(grain,ip,el)
do source = 1, phase_Nsources(phase)
select case(phase_source(source,phase))
case (SOURCE_damage_isoBrittle_ID)
case (DAMAGE_ISOBRITTLE_ID)
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_isoDuctile_ID)
case (DAMAGE_ISODUCTILE_ID)
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoBrittle_ID)
case (DAMAGE_ANISOBRITTLE_ID)
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoDuctile_ID)
case (DAMAGE_ANISODUCTILE_ID)
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case default
@ -214,37 +224,264 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi
end subroutine constitutive_damage_getRateAndItsTangents
!--------------------------------------------------------------------------------------------------
!> @brief integrate stress, state with adaptive 1st order explicit Euler method
!> using Fixed Point Iteration to adapt the stepsize
!--------------------------------------------------------------------------------------------------
module function integrateDamageState(dt,co,ip,el) result(broken)
real(pReal), intent(in) :: dt
integer, intent(in) :: &
el, & !< element index in element loop
ip, & !< integration point index in ip loop
co !< grain index in grain loop
logical :: broken
integer :: &
NiterationState, & !< number of iterations in state loop
ph, &
me, &
so
integer, dimension(maxval(phase_Nsources)) :: &
size_so
real(pReal) :: &
zeta
real(pReal), dimension(constitutive_source_maxSizeDotState) :: &
r ! state residuum
real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState
logical :: &
converged_
ph = material_phaseAt(co,el)
me = material_phaseMemberAt(co,ip,el)
converged_ = .true.
broken = constitutive_damage_collectDotState(co,ip,el,ph,me)
if(broken) return
do so = 1, phase_Nsources(ph)
size_so(so) = damageState(ph)%p(so)%sizeDotState
damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%subState0(1:size_so(so),me) &
+ damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt
source_dotState(1:size_so(so),2,so) = 0.0_pReal
enddo
iteration: do NiterationState = 1, num%nState
do so = 1, phase_Nsources(ph)
if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so)
source_dotState(1:size_so(so),1,so) = damageState(ph)%p(so)%dotState(:,me)
enddo
broken = constitutive_damage_collectDotState(co,ip,el,ph,me)
if(broken) exit iteration
do so = 1, phase_Nsources(ph)
zeta = damper(damageState(ph)%p(so)%dotState(:,me), &
source_dotState(1:size_so(so),1,so),&
source_dotState(1:size_so(so),2,so))
damageState(ph)%p(so)%dotState(:,me) = damageState(ph)%p(so)%dotState(:,me) * zeta &
+ source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta)
r(1:size_so(so)) = damageState(ph)%p(so)%state (1:size_so(so),me) &
- damageState(ph)%p(so)%subState0(1:size_so(so),me) &
- damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt
damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%state(1:size_so(so),me) &
- r(1:size_so(so))
converged_ = converged_ .and. converged(r(1:size_so(so)), &
damageState(ph)%p(so)%state(1:size_so(so),me), &
damageState(ph)%p(so)%atol(1:size_so(so)))
enddo
if(converged_) then
broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me)
exit iteration
endif
enddo iteration
broken = broken .or. .not. converged_
contains
!--------------------------------------------------------------------------------------------------
!> @brief calculate the damping for correction of state and dot state
!--------------------------------------------------------------------------------------------------
real(pReal) pure function damper(current,previous,previous2)
real(pReal), dimension(:), intent(in) ::&
current, previous, previous2
real(pReal) :: dot_prod12, dot_prod22
dot_prod12 = dot_product(current - previous, previous - previous2)
dot_prod22 = dot_product(previous - previous2, previous - previous2)
if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then
damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22)
else
damper = 1.0_pReal
endif
end function damper
end function integrateDamageState
!----------------------------------------------------------------------------------------------
!< @brief writes damage sources results to HDF5 output file
!----------------------------------------------------------------------------------------------
module subroutine damage_results
module subroutine damage_results(group,ph)
integer :: p,i
character(len=pStringLen) :: group
character(len=*), intent(in) :: group
integer, intent(in) :: ph
do p = 1, size(material_name_phase)
integer :: so
sourceLoop: do i = 1, phase_Nsources(p)
group = trim('current/phase')//'/'//trim(material_name_phase(p))
group = trim(group)//'/sources'
call results_closeGroup(results_addGroup(group))
sourceLoop: do so = 1, phase_Nsources(ph)
sourceType: select case (phase_source(i,p))
if (phase_source(so,ph) /= DAMAGE_UNDEFINED_ID) &
call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage'
case (SOURCE_damage_anisoBrittle_ID) sourceType
call source_damage_anisoBrittle_results(p,group)
case (SOURCE_damage_anisoDuctile_ID) sourceType
call source_damage_anisoDuctile_results(p,group)
case (SOURCE_damage_isoBrittle_ID) sourceType
call source_damage_isoBrittle_results(p,group)
case (SOURCE_damage_isoDuctile_ID) sourceType
call source_damage_isoDuctile_results(p,group)
end select sourceType
sourceType: select case (phase_source(so,ph))
enddo SourceLoop
enddo
case (DAMAGE_ISOBRITTLE_ID) sourceType
call source_damage_isoBrittle_results(ph,group//'sources/')
case (DAMAGE_ISODUCTILE_ID) sourceType
call source_damage_isoDuctile_results(ph,group//'sources/')
case (DAMAGE_ANISOBRITTLE_ID) sourceType
call source_damage_anisoBrittle_results(ph,group//'sources/')
case (DAMAGE_ANISODUCTILE_ID) sourceType
call source_damage_anisoDuctile_results(ph,group//'sources/')
end select sourceType
enddo SourceLoop
end subroutine damage_results
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken)
integer, intent(in) :: &
co, & !< component-ID of integration point
ip, & !< integration point
el, & !< element
ph, &
of
integer :: &
so !< counter in source loop
logical :: broken
broken = .false.
SourceLoop: do so = 1, phase_Nsources(ph)
sourceType: select case (phase_source(so,ph))
case (DAMAGE_ISODUCTILE_ID) sourceType
call source_damage_isoDuctile_dotState(co, ip, el)
case (DAMAGE_ANISODUCTILE_ID) sourceType
call source_damage_anisoDuctile_dotState(co, ip, el)
case (DAMAGE_ANISOBRITTLE_ID) sourceType
call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),&
co, ip, el) ! correct stress?
end select sourceType
broken = broken .or. any(IEEE_is_NaN(damageState(ph)%p(so)%dotState(:,of)))
enddo SourceLoop
end function constitutive_damage_collectDotState
!--------------------------------------------------------------------------------------------------
!> @brief for constitutive models having an instantaneous change of state
!> will return false if delta state is not needed/supported by the constitutive model
!--------------------------------------------------------------------------------------------------
function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken)
integer, intent(in) :: &
co, & !< component-ID of integration point
ip, & !< integration point
el, & !< element
ph, &
of
real(pReal), intent(in), dimension(3,3) :: &
Fe !< elastic deformation gradient
integer :: &
so, &
myOffset, &
mySize
logical :: &
broken
broken = .false.
sourceLoop: do so = 1, phase_Nsources(ph)
sourceType: select case (phase_source(so,ph))
case (DAMAGE_ISOBRITTLE_ID) sourceType
call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, &
co, ip, el)
broken = any(IEEE_is_NaN(damageState(ph)%p(so)%deltaState(:,of)))
if(.not. broken) then
myOffset = damageState(ph)%p(so)%offsetDeltaState
mySize = damageState(ph)%p(so)%sizeDeltaState
damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = &
damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + damageState(ph)%p(so)%deltaState(1:mySize,of)
endif
end select sourceType
enddo SourceLoop
end function constitutive_damage_deltaState
!--------------------------------------------------------------------------------------------------
!> @brief checks if a source mechanism is active or not
!--------------------------------------------------------------------------------------------------
function source_active(source_label,src_length) result(active_source)
character(len=*), intent(in) :: source_label !< name of source mechanism
integer, intent(in) :: src_length !< max. number of sources in system
logical, dimension(:,:), allocatable :: active_source
class(tNode), pointer :: &
phases, &
phase, &
sources, &
src
integer :: p,s
phases => config_material%get('phase')
allocate(active_source(src_length,phases%length), source = .false. )
do p = 1, phases%length
phase => phases%get(p)
sources => phase%get('source',defaultVal=emptyList)
do s = 1, sources%length
src => sources%get(s)
if(src%get_asString('type') == source_label) active_source(s,p) = .true.
enddo
enddo
end function source_active
end submodule constitutive_damage

1712
src/constitutive_mech.f90
View File

File diff suppressed because it is too large Load Diff

10
src/constitutive_plastic_dislotwin.f90
View File

@ -485,12 +485,12 @@ end function plastic_dislotwin_init
!--------------------------------------------------------------------------------------------------
!> @brief Return the homogenized elasticity matrix.
!--------------------------------------------------------------------------------------------------
module function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC)
module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC)
real(pReal), dimension(6,6) :: &
homogenizedC
integer, intent(in) :: &
ipc, & !< component-ID of integration point
co, & !< component-ID of integration point
ip, & !< integration point
el !< element
@ -498,9 +498,9 @@ module function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC)
of
real(pReal) :: f_unrotated
of = material_phasememberAt(ipc,ip,el)
associate(prm => param(phase_plasticityInstance(material_phaseAt(ipc,el))),&
stt => state(phase_plasticityInstance(material_phaseAT(ipc,el))))
of = material_phasememberAt(co,ip,el)
associate(prm => param(phase_plasticityInstance(material_phaseAt(co,el))),&
stt => state(phase_plasticityInstance(material_phaseAT(co,el))))
f_unrotated = 1.0_pReal &
- sum(stt%f_tw(1:prm%sum_N_tw,of)) &

38
src/constitutive_plastic_nonlocal.f90
View File

@ -10,7 +10,8 @@ submodule(constitutive:constitutive_mech) plastic_nonlocal
IPneighborhood => geometry_plastic_nonlocal_IPneighborhood, &
IPvolume => geometry_plastic_nonlocal_IPvolume0, &
IParea => geometry_plastic_nonlocal_IParea0, &
IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0
IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0, &
geometry_plastic_nonlocal_disable
real(pReal), parameter :: &
kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin
@ -195,7 +196,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
call geometry_plastic_nonlocal_disable
return
endif
print*, 'Reuber et al., Acta Materialia 71:333–348, 2014'
print*, 'https://doi.org/10.1016/j.actamat.2014.03.012'//IO_EOL
@ -551,11 +552,8 @@ end function plastic_nonlocal_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates quantities characterizing the microstructure
!--------------------------------------------------------------------------------------------------
module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
module subroutine plastic_nonlocal_dependentState(instance, of, ip, el)
real(pReal), dimension(3,3), intent(in) :: &
F, &
Fp
integer, intent(in) :: &
instance, &
of, &
@ -563,6 +561,8 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
el
integer :: &
ph, &
me, &
no, & !< neighbor offset
neighbor_el, & ! element number of neighboring material point
neighbor_ip, & ! integration point of neighboring material point
@ -642,8 +642,10 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
rho0 = getRho0(instance,of,ip,el)
if (.not. phase_localPlasticity(material_phaseAt(1,el)) .and. prm%shortRangeStressCorrection) then
invFp = math_inv33(Fp)
invFe = matmul(Fp,math_inv33(F))
ph = material_phaseAt(1,el)
me = material_phaseMemberAt(1,ip,el)
invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me))
invFe = math_inv33(constitutive_mech_Fe(ph)%data(1:3,1:3,me))
rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg)
rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg)
@ -972,14 +974,11 @@ end subroutine plastic_nonlocal_deltaState
!---------------------------------------------------------------------------------------------------
!> @brief calculates the rate of change of microstructure
!---------------------------------------------------------------------------------------------------
module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, &
instance,of,ip,el)
real(pReal), dimension(3,3), intent(in) :: &
Mp !< MandelStress
real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: &
F, & !< elastic deformation gradient
Fp !< plastic deformation gradient
real(pReal), intent(in) :: &
Temperature, & !< temperature
timestep !< substepped crystallite time increment
@ -1146,7 +1145,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
- rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) &
- rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have
rhoDot = rhoDotFlux(F,Fp,timestep, instance,of,ip,el) &
rhoDot = rhoDotFlux(timestep, instance,of,ip,el) &
+ rhoDotMultiplication &
+ rhoDotSingle2DipoleGlide &
+ rhoDotAthermalAnnihilation &
@ -1175,11 +1174,8 @@ end subroutine plastic_nonlocal_dotState
!---------------------------------------------------------------------------------------------------
!> @brief calculates the rate of change of microstructure
!---------------------------------------------------------------------------------------------------
function rhoDotFlux(F,Fp,timestep, instance,of,ip,el)
function rhoDotFlux(timestep,instance,of,ip,el)
real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: &
F, & !< elastic deformation gradient
Fp !< plastic deformation gradient
real(pReal), intent(in) :: &
timestep !< substepped crystallite time increment
integer, intent(in) :: &
@ -1291,8 +1287,8 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el)
m(1:3,:,3) = -prm%slip_transverse
m(1:3,:,4) = prm%slip_transverse
my_F = F(1:3,1:3,1,ip,el)
my_Fe = matmul(my_F, math_inv33(Fp(1:3,1:3,1,ip,el)))
my_F = constitutive_mech_F(ph)%data(1:3,1:3,of)
my_Fe = matmul(my_F, math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,of)))
neighbors: do n = 1,nIPneighbors
@ -1309,8 +1305,8 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el)
if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient
neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el))
neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el)
neighbor_Fe = matmul(neighbor_F, math_inv33(Fp(1:3,1:3,1,neighbor_ip,neighbor_el)))
neighbor_F = constitutive_mech_F(np)%data(1:3,1:3,no)
neighbor_Fe = matmul(neighbor_F, math_inv33(constitutive_mech_Fp(np)%data(1:3,1:3,no)))
Favg = 0.5_pReal * (my_F + neighbor_F)
else ! if no neighbor, take my value as average
Favg = my_F

329
src/constitutive_thermal.f90
View File

@ -3,13 +3,28 @@
!----------------------------------------------------------------------------------------------------
submodule(constitutive) constitutive_thermal
enum, bind(c); enumerator :: &
THERMAL_UNDEFINED_ID ,&
THERMAL_DISSIPATION_ID, &
THERMAL_EXTERNALHEAT_ID
end enum
type :: tDataContainer
real(pReal), dimension(:), allocatable :: T
end type tDataContainer
integer(kind(THERMAL_UNDEFINED_ID)), dimension(:,:), allocatable :: &
thermal_source
type(tDataContainer), dimension(:), allocatable :: current
integer :: thermal_source_maxSizeDotState
interface
module function source_thermal_dissipation_init(source_length) result(mySources)
integer, intent(in) :: source_length
logical, dimension(:,:), allocatable :: mySources
end function source_thermal_dissipation_init
module function source_thermal_externalheat_init(source_length) result(mySources)
integer, intent(in) :: source_length
logical, dimension(:,:), allocatable :: mySources
@ -21,7 +36,7 @@ submodule(constitutive) constitutive_thermal
end function kinematics_thermal_expansion_init
module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase)
module subroutine thermal_dissipation_getRate(TDot, Tstar,Lp,phase)
integer, intent(in) :: &
phase !< phase ID of element
real(pReal), intent(in), dimension(3,3) :: &
@ -29,18 +44,16 @@ submodule(constitutive) constitutive_thermal
real(pReal), intent(in), dimension(3,3) :: &
Lp !< plastic velocuty gradient for a given element
real(pReal), intent(out) :: &
TDot, &
dTDot_dT
end subroutine source_thermal_dissipation_getRateAndItsTangent
TDot
end subroutine thermal_dissipation_getRate
module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of)
module subroutine thermal_externalheat_getRate(TDot, phase,of)
integer, intent(in) :: &
phase, &
of
real(pReal), intent(out) :: &
TDot, &
dTDot_dT
end subroutine source_thermal_externalheat_getRateAndItsTangent
TDot
end subroutine thermal_externalheat_getRate
end interface
@ -49,14 +62,60 @@ contains
!----------------------------------------------------------------------------------------------
!< @brief initializes thermal sources and kinematics mechanism
!----------------------------------------------------------------------------------------------
module subroutine thermal_init
module subroutine thermal_init(phases)
class(tNode), pointer :: &
phases
class(tNode), pointer :: &
phase, thermal, sources
integer :: &
ph, so, &
Nconstituents
print'(/,a)', ' <<<+- constitutive_thermal init -+>>>'
allocate(current(phases%length))
allocate(thermalState (phases%length))
allocate(thermal_Nsources(phases%length),source = 0)
do ph = 1, phases%length
Nconstituents = count(material_phaseAt == ph) * discretization_nIPs
allocate(current(ph)%T(Nconstituents))
phase => phases%get(ph)
if(phase%contains('thermal')) then
thermal => phase%get('thermal')
sources => thermal%get('source',defaultVal=emptyList)
thermal_Nsources(ph) = sources%length
endif
allocate(thermalstate(ph)%p(thermal_Nsources(ph)))
enddo
allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = THERMAL_UNDEFINED_ID)
if(maxval(thermal_Nsources) /= 0) then
where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = THERMAL_DISSIPATION_ID
where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = THERMAL_EXTERNALHEAT_ID
endif
thermal_source_maxSizeDotState = 0
PhaseLoop2:do ph = 1,phases%length
do so = 1,thermal_Nsources(ph)
thermalState(ph)%p(so)%partitionedState0 = thermalState(ph)%p(so)%state0
thermalState(ph)%p(so)%state = thermalState(ph)%p(so)%partitionedState0
enddo
thermal_source_maxSizeDotState = max(thermal_source_maxSizeDotState, &
maxval(thermalState(ph)%p%sizeDotState))
enddo PhaseLoop2
! initialize source mechanisms
if(maxval(phase_Nsources) /= 0) then
where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID
where(source_thermal_externalheat_init(maxval(phase_Nsources))) phase_source = SOURCE_thermal_externalheat_ID
endif
!--------------------------------------------------------------------------------------------------
!initialize kinematic mechanisms
if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) &
@ -68,58 +127,236 @@ end subroutine thermal_init
!----------------------------------------------------------------------------------------------
!< @brief calculates thermal dissipation rate
!----------------------------------------------------------------------------------------------
module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el)
module subroutine constitutive_thermal_getRate(TDot, T, ip, el)
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
T
real(pReal), intent(in), dimension(:,:,:,:,:) :: &
S, & !< current 2nd Piola Kirchhoff stress
Lp !< plastic velocity gradient
real(pReal), intent(inout) :: &
TDot, &
dTDot_dT
T !< plastic velocity gradient
real(pReal), intent(out) :: &
TDot
real(pReal) :: &
my_Tdot, &
my_dTdot_dT
my_Tdot
integer :: &
phase, &
ph, &
homog, &
instance, &
grain, &
source, &
constituent
me, &
so, &
co
homog = material_homogenizationAt(el)
instance = thermal_typeInstance(homog)
do grain = 1, homogenization_Nconstituents(homog)
phase = material_phaseAt(grain,el)
constituent = material_phasememberAt(grain,ip,el)
do source = 1, phase_Nsources(phase)
select case(phase_source(source,phase))
case (SOURCE_thermal_dissipation_ID)
call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, &
S(1:3,1:3,grain,ip,el), &
Lp(1:3,1:3,grain,ip,el), &
phase)
TDot = 0.0_pReal
do co = 1, homogenization_Nconstituents(homog)
ph = material_phaseAt(co,el)
me = material_phasememberAt(co,ip,el)
do so = 1, thermal_Nsources(ph)
select case(thermal_source(so,ph))
case (THERMAL_DISSIPATION_ID)
call thermal_dissipation_getRate(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph)
case (SOURCE_thermal_externalheat_ID)
call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, &
phase, constituent)
case (THERMAL_EXTERNALHEAT_ID)
call thermal_externalheat_getRate(my_Tdot, ph,me)
case default
my_Tdot = 0.0_pReal
my_dTdot_dT = 0.0_pReal
end select
Tdot = Tdot + my_Tdot
dTdot_dT = dTdot_dT + my_dTdot_dT
enddo
enddo
end subroutine constitutive_thermal_getRateAndItsTangents
end subroutine constitutive_thermal_getRate
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
function constitutive_thermal_collectDotState(ph,me) result(broken)
integer, intent(in) :: ph, me
logical :: broken
integer :: i
broken = .false.
SourceLoop: do i = 1, thermal_Nsources(ph)
if (thermal_source(i,ph) == THERMAL_EXTERNALHEAT_ID) &
call source_thermal_externalheat_dotState(ph,me)
broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,me)))
enddo SourceLoop
end function constitutive_thermal_collectDotState
!--------------------------------------------------------------------------------------------------
!> @brief integrate state with 1st order explicit Euler method
!--------------------------------------------------------------------------------------------------
module function integrateThermalState(Delta_t,co,ip,el) result(broken)
real(pReal), intent(in) :: Delta_t
integer, intent(in) :: &
el, & !< element index in element loop
ip, & !< integration point index in ip loop
co !< grain index in grain loop
logical :: &
broken
integer :: &
ph, &
me, &
so, &
sizeDotState
ph = material_phaseAt(co,el)
me = material_phaseMemberAt(co,ip,el)
broken = constitutive_thermal_collectDotState(ph,me)
if(broken) return
do so = 1, thermal_Nsources(ph)
sizeDotState = thermalState(ph)%p(so)%sizeDotState
thermalState(ph)%p(so)%state(1:sizeDotState,me) = thermalState(ph)%p(so)%subState0(1:sizeDotState,me) &
+ thermalState(ph)%p(so)%dotState(1:sizeDotState,me) * Delta_t
enddo
end function integrateThermalState
module subroutine thermal_initializeRestorationPoints(ph,me)
integer, intent(in) :: ph, me
integer :: so
do so = 1, size(thermalState(ph)%p)
thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state0(:,me)
enddo
end subroutine thermal_initializeRestorationPoints
module subroutine thermal_windForward(ph,me)
integer, intent(in) :: ph, me
integer :: so
do so = 1, size(thermalState(ph)%p)
thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state(:,me)
enddo
end subroutine thermal_windForward
module subroutine thermal_forward()
integer :: ph, so
do ph = 1, size(thermalState)
do so = 1, size(thermalState(ph)%p)
thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state
enddo
enddo
end subroutine thermal_forward
module subroutine thermal_restore(ip,el)
integer, intent(in) :: ip, el
integer :: co, ph, me, so
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
ph = material_phaseAt(co,el)
me = material_phaseMemberAt(co,ip,el)
do so = 1, size(thermalState(ph)%p)
thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me)
enddo
enddo
end subroutine thermal_restore
!----------------------------------------------------------------------------------------------
!< @brief Get temperature (for use by non-thermal physics)
!----------------------------------------------------------------------------------------------
module function thermal_T(ph,me) result(T)
integer, intent(in) :: ph, me
real(pReal) :: T
T = current(ph)%T(me)
end function thermal_T
!----------------------------------------------------------------------------------------------
!< @brief Set temperature
!----------------------------------------------------------------------------------------------
module subroutine constitutive_thermal_setT(T,co,ip,el)
real(pReal), intent(in) :: T
integer, intent(in) :: co, ip, el
current(material_phaseAt(co,el))%T(material_phaseMemberAt(co,ip,el)) = T
end subroutine constitutive_thermal_setT
!--------------------------------------------------------------------------------------------------
!> @brief checks if a source mechanism is active or not
!--------------------------------------------------------------------------------------------------
function thermal_active(source_label,src_length) result(active_source)
character(len=*), intent(in) :: source_label !< name of source mechanism
integer, intent(in) :: src_length !< max. number of sources in system
logical, dimension(:,:), allocatable :: active_source
class(tNode), pointer :: &
phases, &
phase, &
sources, thermal, &
src
integer :: p,s
phases => config_material%get('phase')
allocate(active_source(src_length,phases%length), source = .false. )
do p = 1, phases%length
phase => phases%get(p)
if (phase%contains('thermal')) then
thermal => phase%get('thermal',defaultVal=emptyList)
sources => thermal%get('source',defaultVal=emptyList)
do s = 1, sources%length
src => sources%get(s)
if(src%get_asString('type') == source_label) active_source(s,p) = .true.
enddo
endif
enddo
end function thermal_active
end submodule constitutive_thermal

34
src/source_thermal_dissipation.f90 → src/constitutive_thermal_dissipation.f90
View File

@ -4,7 +4,7 @@
!> @brief material subroutine for thermal source due to plastic dissipation
!> @details to be done
!--------------------------------------------------------------------------------------------------
submodule(constitutive:constitutive_thermal) source_thermal_dissipation
submodule(constitutive:constitutive_thermal) source_dissipation
integer, dimension(:), allocatable :: &
source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism?
@ -27,19 +27,20 @@ contains
!--------------------------------------------------------------------------------------------------
module function source_thermal_dissipation_init(source_length) result(mySources)
integer, intent(in) :: source_length
integer, intent(in) :: source_length
logical, dimension(:,:), allocatable :: mySources
class(tNode), pointer :: &
phases, &
phase, &
sources, &
src
sources, thermal, &
src
integer :: Ninstances,sourceOffset,Nconstituents,p
print'(/,a)', ' <<<+- source_thermal_dissipation init -+>>>'
print'(/,a)', ' <<<+- thermal_dissipation init -+>>>'
mySources = thermal_active('dissipation',source_length)
mySources = source_active('thermal_dissipation',source_length)
Ninstances = count(mySources)
print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT)
if(Ninstances == 0) return
@ -50,19 +51,20 @@ module function source_thermal_dissipation_init(source_length) result(mySources)
allocate(source_thermal_dissipation_instance(phases%length), source=0)
do p = 1, phases%length
phase => phases%get(p)
if(count(mySources(:,p)) == 0) cycle
phase => phases%get(p)
if(any(mySources(:,p))) source_thermal_dissipation_instance(p) = count(mySources(:,1:p))
sources => phase%get('source')
if(count(mySources(:,p)) == 0) cycle
thermal => phase%get('thermal')
sources => thermal%get('source')
do sourceOffset = 1, sources%length
if(mySources(sourceOffset,p)) then
source_thermal_dissipation_offset(p) = sourceOffset
associate(prm => param(source_thermal_dissipation_instance(p)))
src => sources%get(sourceOffset)
src => sources%get(sourceOffset)
prm%kappa = src%get_asFloat('kappa')
Nconstituents = count(material_phaseAt==p) * discretization_nIPs
call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,0,0,0)
call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,0,0,0)
end associate
endif
@ -76,7 +78,7 @@ end function source_thermal_dissipation_init
!--------------------------------------------------------------------------------------------------
!> @brief Ninstancess dissipation rate
!--------------------------------------------------------------------------------------------------
module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase)
module subroutine thermal_dissipation_getRate(TDot, Tstar, Lp, phase)
integer, intent(in) :: &
phase
@ -86,14 +88,12 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT
Lp
real(pReal), intent(out) :: &
TDot, &
dTDot_dT
TDot
associate(prm => param(source_thermal_dissipation_instance(phase)))
TDot = prm%kappa*sum(abs(Tstar*Lp))
dTDot_dT = 0.0_pReal
end associate
end subroutine source_thermal_dissipation_getRateAndItsTangent
end subroutine thermal_dissipation_getRate
end submodule source_thermal_dissipation
end submodule source_dissipation

39
src/source_thermal_externalheat.f90 → src/constitutive_thermal_externalheat.f90
View File

@ -4,7 +4,7 @@
!> @author Philip Eisenlohr, Michigan State University
!> @brief material subroutine for variable heat source
!--------------------------------------------------------------------------------------------------
submodule(constitutive:constitutive_thermal) source_thermal_externalheat
submodule(constitutive:constitutive_thermal) source_externalheat
integer, dimension(:), allocatable :: &
@ -13,7 +13,7 @@ submodule(constitutive:constitutive_thermal) source_thermal_externalheat
type :: tParameters !< container type for internal constitutive parameters
real(pReal), dimension(:), allocatable :: &
t_n, &
t_n, &
f_T
integer :: &
nIntervals
@ -31,19 +31,20 @@ contains
!--------------------------------------------------------------------------------------------------
module function source_thermal_externalheat_init(source_length) result(mySources)
integer, intent(in) :: source_length
integer, intent(in) :: source_length
logical, dimension(:,:), allocatable :: mySources
class(tNode), pointer :: &
phases, &
phase, &
sources, &
src
sources, thermal, &
src
integer :: Ninstances,sourceOffset,Nconstituents,p
print'(/,a)', ' <<<+- source_thermal_externalHeat init -+>>>'
print'(/,a)', ' <<<+- thermal_externalheat init -+>>>'
mySources = thermal_active('externalheat',source_length)
mySources = source_active('thermal_externalheat',source_length)
Ninstances = count(mySources)
print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT)
if(Ninstances == 0) return
@ -54,15 +55,16 @@ module function source_thermal_externalheat_init(source_length) result(mySources
allocate(source_thermal_externalheat_instance(phases%length), source=0)
do p = 1, phases%length
phase => phases%get(p)
phase => phases%get(p)
if(any(mySources(:,p))) source_thermal_externalheat_instance(p) = count(mySources(:,1:p))
if(count(mySources(:,p)) == 0) cycle
sources => phase%get('source')
thermal => phase%get('thermal')
sources => thermal%get('source')
do sourceOffset = 1, sources%length
if(mySources(sourceOffset,p)) then
source_thermal_externalheat_offset(p) = sourceOffset
associate(prm => param(source_thermal_externalheat_instance(p)))
src => sources%get(sourceOffset)
src => sources%get(sourceOffset)
prm%t_n = src%get_asFloats('t_n')
prm%nIntervals = size(prm%t_n) - 1
@ -70,9 +72,8 @@ module function source_thermal_externalheat_init(source_length) result(mySources
prm%f_T = src%get_asFloats('f_T',requiredSize = size(prm%t_n))
Nconstituents = count(material_phaseAt==p) * discretization_nIPs
call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,1,1,0)
end associate
endif
enddo
enddo
@ -95,7 +96,7 @@ module subroutine source_thermal_externalheat_dotState(phase, of)
sourceOffset = source_thermal_externalheat_offset(phase)
sourceState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal ! state is current time
thermalState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal ! state is current time
end subroutine source_thermal_externalheat_dotState
@ -103,14 +104,13 @@ end subroutine source_thermal_externalheat_dotState
!--------------------------------------------------------------------------------------------------
!> @brief returns local heat generation rate
!--------------------------------------------------------------------------------------------------
module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of)
module subroutine thermal_externalheat_getRate(TDot, phase, of)
integer, intent(in) :: &
phase, &
of
real(pReal), intent(out) :: &
TDot, &
dTDot_dT
TDot
integer :: &
sourceOffset, interval
@ -121,7 +121,7 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d
associate(prm => param(source_thermal_externalheat_instance(phase)))
do interval = 1, prm%nIntervals ! scan through all rate segments
frac_time = (sourceState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) &
frac_time = (thermalState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) &
/ (prm%t_n(interval+1) - prm%t_n(interval)) ! fractional time within segment
if ( (frac_time < 0.0_pReal .and. interval == 1) &
.or. (frac_time >= 1.0_pReal .and. interval == prm%nIntervals) &
@ -130,9 +130,8 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d
prm%f_T(interval+1) * frac_time ! interpolate heat rate between segment boundaries...
! ...or extrapolate if outside of bounds
enddo
dTDot_dT = 0.0
end associate
end subroutine source_thermal_externalheat_getRateAndItsTangent
end subroutine thermal_externalheat_getRate
end submodule source_thermal_externalheat
end submodule source_externalheat

1647
src/crystallite.f90
View File

File diff suppressed because it is too large Load Diff

175
src/damage_local.f90
View File

@ -1,175 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for locally evolving damage field
!--------------------------------------------------------------------------------------------------
module damage_local
use prec
use IO
use material
use config
use YAML_types
use constitutive
use results
implicit none
private
type :: tParameters
character(len=pStringLen), allocatable, dimension(:) :: &
output
end type tParameters
type, private :: tNumerics
real(pReal) :: &
residualStiffness !< non-zero residual damage
end type tNumerics
type(tparameters), dimension(:), allocatable :: &
param
type(tNumerics), private :: num
public :: &
damage_local_init, &
damage_local_updateState, &
damage_local_results
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine damage_local_init
integer :: Ninstances,Nmaterialpoints,h
class(tNode), pointer :: &
num_generic, &
material_homogenization, &
homog, &
homogDamage
print'(/,a)', ' <<<+- damage_local init -+>>>'; flush(IO_STDOUT)
!----------------------------------------------------------------------------------------------
! read numerics parameter and do sanity check
num_generic => config_numerics%get('generic',defaultVal=emptyDict)
num%residualStiffness = num_generic%get_asFloat('residualStiffness', defaultVal=1.0e-6_pReal)
if (num%residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness')
Ninstances = count(damage_type == DAMAGE_local_ID)
allocate(param(Ninstances))
material_homogenization => config_material%get('homogenization')
do h = 1, material_homogenization%length
if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle
homog => material_homogenization%get(h)
homogDamage => homog%get('damage')
associate(prm => param(damage_typeInstance(h)))
#if defined (__GFORTRAN__)
prm%output = output_asStrings(homogDamage)
#else
prm%output = homogDamage%get_asStrings('output',defaultVal=emptyStringArray)
#endif
Nmaterialpoints = count(material_homogenizationAt == h)
damageState(h)%sizeState = 1
allocate(damageState(h)%state0 (1,Nmaterialpoints), source=damage_initialPhi(h))
allocate(damageState(h)%subState0(1,Nmaterialpoints), source=damage_initialPhi(h))
allocate(damageState(h)%state (1,Nmaterialpoints), source=damage_initialPhi(h))
nullify(damageMapping(h)%p)
damageMapping(h)%p => material_homogenizationMemberAt
deallocate(damage(h)%p)
damage(h)%p => damageState(h)%state(1,:)
end associate
enddo
end subroutine damage_local_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates local change in damage field
!--------------------------------------------------------------------------------------------------
function damage_local_updateState(subdt, ip, el)
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
subdt
logical, dimension(2) :: &
damage_local_updateState
integer :: &
homog, &
offset
real(pReal) :: &
phi, phiDot, dPhiDot_dPhi
homog = material_homogenizationAt(el)
offset = material_homogenizationMemberAt(ip,el)
phi = damageState(homog)%subState0(1,offset)
call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
phi = max(num%residualStiffness,min(1.0_pReal,phi + subdt*phiDot))
damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) &
<= 1.0e-2_pReal &
.or. abs(phi - damageState(homog)%state(1,offset)) &
<= 1.0e-6_pReal*abs(damageState(homog)%state(1,offset)), &
.true.]
damageState(homog)%state(1,offset) = phi
end function damage_local_updateState
!--------------------------------------------------------------------------------------------------
!> @brief calculates homogenized local damage driving forces
!--------------------------------------------------------------------------------------------------
subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
phi
real(pReal) :: &
phiDot, dPhiDot_dPhi
phiDot = 0.0_pReal
dPhiDot_dPhi = 0.0_pReal
call constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ip, el)
phiDot = phiDot/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
end subroutine damage_local_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine damage_local_results(homog,group)
integer, intent(in) :: homog
character(len=*), intent(in) :: group
integer :: o
associate(prm => param(damage_typeInstance(homog)))
outputsLoop: do o = 1,size(prm%output)
select case(prm%output(o))
case ('phi')
call results_writeDataset(group,damage(homog)%p,prm%output(o),&
'damage indicator','-')
end select
enddo outputsLoop
end associate
end subroutine damage_local_results
end module damage_local

12
src/damage_none.f90
View File

@ -3,6 +3,7 @@
!> @brief material subroutine for constant damage field
!--------------------------------------------------------------------------------------------------
module damage_none
use prec
use config
use material
@ -24,13 +25,12 @@ subroutine damage_none_init
if (damage_type(h) /= DAMAGE_NONE_ID) cycle
Nmaterialpoints = count(material_homogenizationAt == h)
damageState(h)%sizeState = 0
allocate(damageState(h)%state0 (0,Nmaterialpoints))
allocate(damageState(h)%subState0(0,Nmaterialpoints))
allocate(damageState(h)%state (0,Nmaterialpoints))
damageState_h(h)%sizeState = 0
allocate(damageState_h(h)%state0 (0,Nmaterialpoints))
allocate(damageState_h(h)%subState0(0,Nmaterialpoints))
allocate(damageState_h(h)%state (0,Nmaterialpoints))
deallocate(damage(h)%p)
allocate (damage(h)%p(1), source=damage_initialPhi(h))
allocate (damage(h)%p(Nmaterialpoints), source=1.0_pReal)
enddo

22
src/damage_nonlocal.f90
View File

@ -7,7 +7,6 @@ module damage_nonlocal
use material
use config
use YAML_types
use crystallite
use lattice
use constitutive
use results
@ -77,15 +76,12 @@ subroutine damage_nonlocal_init
#endif
Nmaterialpoints = count(material_homogenizationAt == h)
damageState(h)%sizeState = 1
allocate(damageState(h)%state0 (1,Nmaterialpoints), source=damage_initialPhi(h))
allocate(damageState(h)%subState0(1,Nmaterialpoints), source=damage_initialPhi(h))
allocate(damageState(h)%state (1,Nmaterialpoints), source=damage_initialPhi(h))
damageState_h(h)%sizeState = 1
allocate(damageState_h(h)%state0 (1,Nmaterialpoints), source=1.0_pReal)
allocate(damageState_h(h)%subState0(1,Nmaterialpoints), source=1.0_pReal)
allocate(damageState_h(h)%state (1,Nmaterialpoints), source=1.0_pReal)
nullify(damageMapping(h)%p)
damageMapping(h)%p => material_homogenizationMemberAt
deallocate(damage(h)%p)
damage(h)%p => damageState(h)%state(1,:)
damage(h)%p => damageState_h(h)%state(1,:)
end associate
enddo
@ -152,12 +148,12 @@ real(pReal) function damage_nonlocal_getMobility(ip,el)
ip, & !< integration point number
el !< element number
integer :: &
ipc
co
damage_nonlocal_getMobility = 0.0_pReal
do ipc = 1, homogenization_Nconstituents(material_homogenizationAt(el))
damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_M(material_phaseAt(ipc,el))
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_M(material_phaseAt(co,el))
enddo
damage_nonlocal_getMobility = damage_nonlocal_getMobility/&
@ -181,7 +177,7 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el)
offset
homog = material_homogenizationAt(el)
offset = damageMapping(homog)%p(ip,el)
offset = material_homogenizationMemberAt(ip,el)
damage(homog)%p(offset) = phi
end subroutine damage_nonlocal_putNonLocalDamage

111
src/grid/DAMASK_grid.f90
View File

@ -42,8 +42,8 @@ program DAMASK_grid
!--------------------------------------------------------------------------------------------------
! 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
real(pReal), dimension(9) :: temp_valueVector !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
logical, dimension(9) :: temp_maskVector !< temporarily from loadcase file when reading in tensors
!--------------------------------------------------------------------------------------------------
! loop variables, convergence etc.
@ -145,8 +145,6 @@ program DAMASK_grid
mech_restartWrite => grid_mech_spectral_basic_restartWrite
case ('Polarisation')
if(debug_grid%contains('basic')) &
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
@ -154,8 +152,6 @@ program DAMASK_grid
mech_restartWrite => grid_mech_spectral_polarisation_restartWrite
case ('FEM')
if(debug_grid%contains('basic')) &
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
@ -180,11 +176,11 @@ program DAMASK_grid
allocate(loadCases(l)%ID(nActiveFields))
field = 1
loadCases(l)%ID(field) = FIELD_MECH_ID ! mechanical active by default
thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then
thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then
field = field + 1
loadCases(l)%ID(field) = FIELD_THERMAL_ID
endif thermalActive
damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then
damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then
field = field + 1
loadCases(l)%ID(field) = FIELD_DAMAGE_ID
endif damageActive
@ -192,33 +188,35 @@ program DAMASK_grid
load_step => load_steps%get(l)
step_mech => load_step%get('mechanics')
loadCases(l)%stress%myType='P'
loadCases(l)%stress%myType=''
readMech: do m = 1, step_mech%length
select case (step_mech%getKey(m))
case('dot_F','L','F') ! assign values for the deformation BC matrix
case ('L','dot_F','F') ! assign values for the deformation BC matrix
loadCases(l)%deformation%myType = step_mech%getKey(m)
temp_valueVector = 0.0_pReal
step_deformation => step_mech%get(m)
do j = 1, 9
temp_maskVector(j) = step_deformation%get_asString(j) /= 'x' ! true if not a 'x'
if (temp_maskVector(j)) temp_valueVector(j) = step_deformation%get_asFloat(j) ! read value where applicable
enddo
loadCases(l)%deformation%mask = transpose(reshape(temp_maskVector,[ 3,3])) ! mask in 3x3 notation
loadCases(l)%deformation%values = math_9to33(temp_valueVector) ! values in 3x3 notation
case('P')
temp_valueVector = 0.0_pReal
step_stress => step_mech%get(m)
do j = 1, 9
temp_maskVector(j) = step_stress%get_asString(j) /= 'x' ! true if not a 'x'
if (temp_maskVector(j)) temp_valueVector(j) = step_stress%get_asFloat(j) ! read value where applicable
temp_maskVector(j) = step_deformation%get_asString(j) /= 'x'
if (temp_maskVector(j)) temp_valueVector(j) = step_deformation%get_asFloat(j)
enddo
loadCases(l)%stress%mask = transpose(reshape(temp_maskVector,[ 3,3]))
loadCases(l)%deformation%mask = transpose(reshape(temp_maskVector,[3,3]))
loadCases(l)%deformation%values = math_9to33(temp_valueVector)
case ('dot_P','P')
loadCases(l)%stress%myType = step_mech%getKey(m)
step_stress => step_mech%get(m)
temp_valueVector = 0.0_pReal
do j = 1, 9
temp_maskVector(j) = step_stress%get_asString(j) /= 'x'
if (temp_maskVector(j)) temp_valueVector(j) = step_stress%get_asFloat(j)
enddo
loadCases(l)%stress%mask = transpose(reshape(temp_maskVector,[3,3]))
loadCases(l)%stress%values = math_9to33(temp_valueVector)
end select
call loadCases(l)%rot%fromAxisAngle(step_mech%get_asFloats('R',defaultVal = real([0.0,0.0,1.0,0.0],pReal)),degrees=.true.)
enddo readMech
if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/F/dot_F missing')
if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/dot_F/F missing')
step_discretization => load_step%get('discretization')
if(.not. step_discretization%contains('t')) call IO_error(error_ID=837,ext_msg = 't missing')
@ -241,50 +239,60 @@ program DAMASK_grid
if (any(loadCases(l)%deformation%mask(j,1:3) .eqv. .true.) .and. &
any(loadCases(l)%deformation%mask(j,1:3) .eqv. .false.)) errorID = 832 ! each row should be either fully or not at all defined
enddo
print*, ' L:'
else if (loadCases(l)%deformation%myType == 'F') then
endif
if (loadCases(l)%deformation%myType == 'F') then
print*, ' F:'
else if (loadCases(l)%deformation%myType == 'dot_F') then
print*, ' dot_F:'
else
print*, ' '//loadCases(l)%deformation%myType//' / 1/s:'
endif
do i = 1, 3; do j = 1, 3
if(loadCases(l)%deformation%mask(i,j)) then
if (loadCases(l)%deformation%mask(i,j)) then
write(IO_STDOUT,'(2x,f12.7)',advance='no') loadCases(l)%deformation%values(i,j)
else
write(IO_STDOUT,'(2x,12a)',advance='no') ' x '
endif
enddo; write(IO_STDOUT,'(/)',advance='no')
enddo
if (any(loadCases(l)%stress%mask .eqv. loadCases(l)%deformation%mask)) errorID = 831 ! exclusive or masking only
if (any(loadCases(l)%stress%mask .and. transpose(loadCases(l)%stress%mask) .and. (math_I3<1))) &
errorID = 838 ! no rotation is allowed by stress BC
print*, ' P / MPa:'
do i = 1, 3; do j = 1, 3
if(loadCases(l)%stress%mask(i,j)) then
write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal
else
write(IO_STDOUT,'(2x,12a)',advance='no') ' x '
endif
enddo; write(IO_STDOUT,'(/)',advance='no')
enddo
if (any(loadCases(l)%stress%mask .eqv. loadCases(l)%deformation%mask)) errorID = 831
if (any(loadCases(l)%stress%mask .and. transpose(loadCases(l)%stress%mask) .and. (math_I3<1))) &
errorID = 838 ! no rotation is allowed by stress BC
if (loadCases(l)%stress%myType == 'P') print*, ' P / MPa:'
if (loadCases(l)%stress%myType == 'dot_P') print*, ' dot_P / MPa/s:'
if (loadCases(l)%stress%myType /= '') then
do i = 1, 3; do j = 1, 3
if (loadCases(l)%stress%mask(i,j)) then
write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal
else
write(IO_STDOUT,'(2x,12a)',advance='no') ' x '
endif
enddo; write(IO_STDOUT,'(/)',advance='no')
enddo
endif
if (any(dNeq(loadCases(l)%rot%asMatrix(), math_I3))) &
write(IO_STDOUT,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'R:',&
transpose(loadCases(l)%rot%asMatrix())
if (loadCases(l)%t < 0.0_pReal) errorID = 834
print'(a,f0.3)', ' t: ', loadCases(l)%t
if (loadCases(l)%N < 1) errorID = 835
print'(a,i0)', ' N: ', loadCases(l)%N
if (loadCases(l)%f_out < 1) errorID = 836
print'(a,i0)', ' f_out: ', loadCases(l)%f_out
if (loadCases(l)%r <= 0.0) errorID = 833
print'(a,f0.3)', ' r: ', loadCases(l)%r
if (loadCases(l)%r <= 0.0) errorID = 833
if (loadCases(l)%t < 0.0_pReal) errorID = 834
if (loadCases(l)%N < 1) errorID = 835
if (loadCases(l)%f_out < 1) errorID = 836
if (loadCases(l)%f_restart < 1) errorID = 839
if (dEq(loadCases(l)%r,1.0_pReal,1.e-9_pReal)) then
print'(a)', ' r: 1 (constant step widths)'
else
print'(a,f0.3)', ' r: ', loadCases(l)%r
endif
print'(a,f0.3)', ' t: ', loadCases(l)%t
print'(a,i0)', ' N: ', loadCases(l)%N
print'(a,i0)', ' f_out: ', loadCases(l)%f_out
if (loadCases(l)%f_restart < huge(0)) &
print'(a,i0)', ' f_restart: ', loadCases(l)%f_restart
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
endif reportAndCheck
enddo
@ -311,8 +319,6 @@ program DAMASK_grid
writeHeader: if (interface_restartInc < 1) then
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (debug_grid%contains('basic')) print'(/,a)', ' header of statistics file written out'
flush(IO_STDOUT)
else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD')
@ -321,6 +327,7 @@ program DAMASK_grid
writeUndeformed: if (interface_restartInc < 1) then
print'(/,a)', ' ... writing initial configuration to file ........................'
flush(IO_STDOUT)
call CPFEM_results(0,0.0_pReal)
endif writeUndeformed

4
src/grid/discretization_grid.f90
View File

@ -19,7 +19,6 @@ module discretization_grid
use results
use discretization
use geometry_plastic_nonlocal
use FEsolving
implicit none
private
@ -117,9 +116,6 @@ subroutine discretization_grid_init(restart)
(grid(1)+1) * (grid(2)+1) * grid3,& ! ...unless not last process
worldrank+1==worldsize))
FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements
FEsolving_execIP = [1,1] ! parallel loop bounds set to comprise the only IP
!--------------------------------------------------------------------------------------------------
! store geometry information for post processing
if(.not. restart) then

3
src/grid/grid_damage_spectral.f90
View File

@ -203,8 +203,7 @@ function grid_damage_spectral_solution(timeinc) result(solution)
call VecMax(solution_vec,devNull,phi_max,ierr); CHKERRQ(ierr)
if (solution%converged) &
print'(/,a)', ' ... nonlocal damage converged .....................................'
write(IO_STDOUT,'(/,a,f8.6,2x,f8.6,2x,e11.4,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',&
phi_min, phi_max, stagNorm
print'(/,a,f8.6,2x,f8.6,2x,e11.4)', ' Minimum|Maximum|Delta Damage = ', phi_min, phi_max, stagNorm
print'(/,a)', ' ==========================================================================='
flush(IO_STDOUT)

161
src/grid/grid_mech_FEM.f90
View File

@ -18,7 +18,6 @@ module grid_mech_FEM
use math
use rotations
use spectral_utilities
use FEsolving
use config
use homogenization
use discretization
@ -31,16 +30,16 @@ module grid_mech_FEM
type :: tNumerics
integer :: &
itmin, & !< minimum number of iterations
itmax !< maximum number of iterations
itmin, & !< minimum number of iterations
itmax !< maximum number of iterations
real(pReal) :: &
eps_div_atol, & !< absolute tolerance for equilibrium
eps_div_rtol, & !< relative tolerance for equilibrium
eps_stress_atol, & !< absolute tolerance for fullfillment of stress BC
eps_stress_rtol !< relative tolerance for fullfillment of stress BC
eps_div_atol, & !< absolute tolerance for equilibrium
eps_div_rtol, & !< relative tolerance for equilibrium
eps_stress_atol, & !< absolute tolerance for fullfillment of stress BC
eps_stress_rtol !< relative tolerance for fullfillment of stress BC
end type tNumerics
type(tNumerics) :: num ! numerics parameters. Better name?
type(tNumerics) :: num ! numerics parameters. Better name?
logical :: debugRotation
@ -64,7 +63,7 @@ module grid_mech_FEM
real(pReal), dimension(3,3) :: &
F_aimDot = 0.0_pReal, & !< assumed rate of average deformation gradient
F_aim = math_I3, & !< current prescribed deformation gradient
F_aim_lastInc = math_I3, & !< previous average deformation gradient
F_aim_lastInc = math_I3, & !< previous average deformation gradient
P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress
P_aim = 0.0_pReal
character(len=:), allocatable :: incInfo !< time and increment information
@ -93,10 +92,8 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_FEM_init
real(pReal) :: HGCoeff = 0.0e-2_pReal
real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal
real(pReal), dimension(4,8) :: &
real(pReal), parameter :: HGCoeff = 0.0e-2_pReal
real(pReal), parameter, dimension(4,8) :: &
HGcomp = reshape([ 1.0_pReal, 1.0_pReal, 1.0_pReal,-1.0_pReal, &
1.0_pReal,-1.0_pReal,-1.0_pReal, 1.0_pReal, &
-1.0_pReal, 1.0_pReal,-1.0_pReal, 1.0_pReal, &
@ -121,18 +118,19 @@ subroutine grid_mech_FEM_init
!-------------------------------------------------------------------------------------------------
! debugging options
debug_grid => config_debug%get('grid', defaultVal=emptyList)
debug_grid => config_debug%get('grid',defaultVal=emptyList)
debugRotation = debug_grid%contains('rotation')
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get('grid',defaultVal=emptyDict)
num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal)
num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal)
num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal)
num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal)
num%itmin = num_grid%get_asInt ('itmin', defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol')
if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol')
@ -225,6 +223,7 @@ subroutine grid_mech_FEM_init
fileHandle = HDF5_openFile(fileName)
groupHandle = HDF5_openGroup(fileHandle,'solver')
call HDF5_read(groupHandle,P_aim, 'P_aim')
call HDF5_read(groupHandle,F_aim, 'F_aim')
call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc')
call HDF5_read(groupHandle,F_aimDot, 'F_aimDot')
@ -238,9 +237,9 @@ subroutine grid_mech_FEM_init
F = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3)
endif restartRead
homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent
homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent
call utilities_updateCoords(F)
call utilities_constitutiveResponse(P_current,temp33_Real,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2
call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2
F, & ! target F
0.0_pReal) ! time increment
call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr)
@ -295,6 +294,7 @@ function grid_mech_FEM_solution(incInfoIn) result(solution)
solution%iterationsNeeded = totalIter
solution%termIll = terminallyIll
terminallyIll = .false.
P_aim = merge(P_aim,P_av,params%stress_mask)
end function grid_mech_FEM_solution
@ -302,34 +302,26 @@ end function grid_mech_FEM_solution
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,&
subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
deformation_BC,stress_BC,rotation_BC)
logical, intent(in) :: &
logical, intent(in) :: &
cutBack, &
guess
real(pReal), intent(in) :: &
timeinc_old, &
timeinc, &
loadCaseTime !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: &
real(pReal), intent(in) :: &
Delta_t_old, &
Delta_t, &
t_remaining !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: &
stress_BC, &
deformation_BC
type(rotation), intent(in) :: &
type(rotation), intent(in) :: &
rotation_BC
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: &
u_current,u_lastInc
!--------------------------------------------------------------------------------------------------
! set module wide available data
params%stress_mask = stress_BC%mask
params%rotation_BC = rotation_BC
params%timeinc = timeinc
params%timeincOld = timeinc_old
call DMDAVecGetArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr)
call DMDAVecGetArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr)
@ -339,7 +331,7 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,
else
C_volAvgLastInc = C_volAvg
F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)
F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) ! estimate deformation rate for prescribed stress components
F_aim_lastInc = F_aim
!-----------------------------------------------------------------------------------------------
@ -347,18 +339,18 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,
if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F
F_aimDot = F_aimDot &
+ merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask)
elseif(deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
+ merge(deformation_BC%values,.0_pReal,deformation_BC%mask)
elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed
F_aimDot = F_aimDot &
+ merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask)
+ merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask)
endif
if (guess) then
call VecWAXPY(solution_rate,-1.0_pReal,solution_lastInc,solution_current,ierr)
CHKERRQ(ierr)
call VecScale(solution_rate,1.0_pReal/timeinc_old,ierr); CHKERRQ(ierr)
call VecScale(solution_rate,1.0_pReal/Delta_t_old,ierr); CHKERRQ(ierr)
else
call VecSet(solution_rate,0.0_pReal,ierr); CHKERRQ(ierr)
endif
@ -366,28 +358,33 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,
F_lastInc = F
homogenization_F0 = reshape(F, [3,3,1,product(grid(1:2))*grid3])
homogenization_F0 = reshape(F, [3,3,product(grid(1:2))*grid3])
endif
!--------------------------------------------------------------------------------------------------
! update average and local deformation gradients
F_aim = F_aim_lastInc + F_aimDot * timeinc
if (stress_BC%myType=='P') then
P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask)
elseif (stress_BC%myType=='dot_P') then !UNTESTED
P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask)
endif
F_aim = F_aim_lastInc + F_aimDot * Delta_t
if (stress_BC%myType=='P') P_aim = P_aim &
+ merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t
if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t
call VecAXPY(solution_current,timeinc,solution_rate,ierr); CHKERRQ(ierr)
call VecAXPY(solution_current,Delta_t,solution_rate,ierr); CHKERRQ(ierr)
call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr);CHKERRQ(ierr)
call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr);CHKERRQ(ierr)
call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr)
call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! set module wide available data
params%stress_mask = stress_BC%mask
params%rotation_BC = rotation_BC
params%timeinc = Delta_t
end subroutine grid_mech_FEM_forward
!--------------------------------------------------------------------------------------------------
!> @brief Age
!> @brief Update coordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_FEM_updateCoords
@ -415,6 +412,7 @@ subroutine grid_mech_FEM_restartWrite
fileHandle = HDF5_openFile(fileName,'w')
groupHandle = HDF5_addGroup(fileHandle,'solver')
call HDF5_write(groupHandle,P_aim, 'P_aim')
call HDF5_write(groupHandle,F_aim, 'F_aim')
call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc')
call HDF5_write(groupHandle,F_aimDot, 'F_aimDot')
@ -441,11 +439,11 @@ end subroutine grid_mech_FEM_restartWrite
subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,ierr)
SNES :: snes_local
PetscInt, intent(in) :: PETScIter
PetscReal, intent(in) :: &
devNull1, &
devNull2, &
fnorm
PetscInt, intent(in) :: PETScIter
PetscReal, intent(in) :: &
devNull1, &
devNull2, &
fnorm
SNESConvergedReason :: reason
PetscObject :: dummy
PetscErrorCode :: ierr
@ -458,10 +456,10 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,i
divTol = max(maxval(abs(P_av))*num%eps_div_rtol ,num%eps_div_atol)
BCTol = max(maxval(abs(P_av))*num%eps_stress_rtol,num%eps_stress_atol)
if ((totalIter >= num%itmin .and. &
all([ err_div/divTol, &
err_BC /BCTol ] < 1.0_pReal)) &
.or. terminallyIll) then
if (terminallyIll .or. &
(totalIter >= num%itmin .and. &
all([ err_div/divTol, &
err_BC /BCTol ] < 1.0_pReal))) then
reason = 1
elseif (totalIter >= num%itmax) then
reason = -1
@ -510,11 +508,10 @@ subroutine formResidual(da_local,x_local, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax
if (debugRotation) &
write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim =', transpose(F_aim)
if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
' deformation gradient aim =', transpose(F_aim)
flush(IO_STDOUT)
endif newIteration
@ -559,9 +556,9 @@ subroutine formResidual(da_local,x_local, &
ii = i-xstart+1; jj = j-ystart+1; kk = k-zstart+1
ele = ele + 1
f_elem = matmul(transpose(BMat),transpose(P_current(1:3,1:3,ii,jj,kk)))*detJ + &
matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,1,ele) + &
homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,ele) + &
homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
ctr = 0
do kk = 0, 1; do jj = 0, 1; do ii = 0, 1
ctr = ctr + 1
@ -638,18 +635,18 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
row = col
ele = ele + 1
K_ele = 0.0
K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,1,ele) + &
homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,1,ele) + &
homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,1,ele) + &
homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,ele) + &
homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,ele) + &
homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,ele) + &
homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
K_ele = K_ele + &
matmul(transpose(BMatFull), &
matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,1,ele), &
matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,ele), &
shape=[3,3,3,3], order=[2,1,4,3]),shape=[9,9]),BMatFull))*detJ
call MatSetValuesStencil(Jac,24,row,24,col,K_ele,ADD_VALUES,ierr)
CHKERRQ(ierr)
@ -666,16 +663,16 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
C_volAvg(3,3,3,3)/delta(3)**2.0_pReal)*detJ
call MatZeroRowsColumns(Jac,size(rows),rows,diag,PETSC_NULL_VEC,PETSC_NULL_VEC,ierr)
CHKERRQ(ierr)
call DMGetGlobalVector(da_local,coordinates,ierr);CHKERRQ(ierr)
call DMDAVecGetArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr)
call DMGetGlobalVector(da_local,coordinates,ierr); CHKERRQ(ierr)
call DMDAVecGetArrayF90(da_local,coordinates,x_scal,ierr); CHKERRQ(ierr)
ele = 0
do k = zstart, zend; do j = ystart, yend; do i = xstart, xend
ele = ele + 1
x_scal(0:2,i,j,k) = discretization_IPcoords(1:3,ele)
enddo; enddo; enddo
call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr) ! initialize to undeformed coordinates (ToDo: use ip coordinates)
call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr);CHKERRQ(ierr) ! get rigid body deformation modes
call DMRestoreGlobalVector(da_local,coordinates,ierr);CHKERRQ(ierr)
call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr); CHKERRQ(ierr) ! initialize to undeformed coordinates (ToDo: use ip coordinates)
call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr); CHKERRQ(ierr) ! get rigid body deformation modes
call DMRestoreGlobalVector(da_local,coordinates,ierr); CHKERRQ(ierr)
call MatSetNullSpace(Jac,matnull,ierr); CHKERRQ(ierr)
call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr)
call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr)

105
src/grid/grid_mech_spectral_basic.f90
View File

@ -18,7 +18,6 @@ module grid_mech_spectral_basic
use math
use rotations
use spectral_utilities
use FEsolving
use config
use homogenization
use discretization_grid
@ -94,8 +93,6 @@ contains
subroutine grid_mech_spectral_basic_init
real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: &
F ! pointer to solution data
@ -118,20 +115,20 @@ subroutine grid_mech_spectral_basic_init
!-------------------------------------------------------------------------------------------------
! debugging options
debug_grid => config_debug%get('grid', defaultVal=emptyList)
debug_grid => config_debug%get('grid',defaultVal=emptyList)
debugRotation = debug_grid%contains('rotation')
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get('grid',defaultVal=emptyDict)
num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.)
num%eps_div_atol = num_grid%get_asFloat ('eps_div_atol', defaultVal=1.0e-4_pReal)
num%eps_div_rtol = num_grid%get_asFloat ('eps_div_rtol', defaultVal=5.0e-4_pReal)
num%eps_stress_atol = num_grid%get_asFloat ('eps_stress_atol',defaultVal=1.0e3_pReal)
num%eps_stress_rtol = num_grid%get_asFloat ('eps_stress_rtol',defaultVal=1.0e-3_pReal)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.)
num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal)
num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal)
num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal)
num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol')
if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol')
@ -139,7 +136,7 @@ subroutine grid_mech_spectral_basic_init
if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol')
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin')
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mech_snes_type ngmres',ierr)
@ -149,14 +146,14 @@ subroutine grid_mech_spectral_basic_init
!--------------------------------------------------------------------------------------------------
! allocate global fields
allocate (F_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
allocate (Fdot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
allocate(F_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
allocate(Fdot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
localK = 0
localK = 0
localK(worldrank) = grid3
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
call DMDACreate3d(PETSC_COMM_WORLD, &
@ -189,6 +186,7 @@ subroutine grid_mech_spectral_basic_init
fileHandle = HDF5_openFile(fileName)
groupHandle = HDF5_openGroup(fileHandle,'solver')
call HDF5_read(groupHandle,P_aim, 'P_aim')
call HDF5_read(groupHandle,F_aim, 'F_aim')
call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc')
call HDF5_read(groupHandle,F_aimDot, 'F_aimDot')
@ -200,9 +198,9 @@ subroutine grid_mech_spectral_basic_init
F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])
endif restartRead
homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent
homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent
call utilities_updateCoords(reshape(F,shape(F_lastInc)))
call utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
reshape(F,shape(F_lastInc)), & ! target F
0.0_pReal) ! time increment
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! deassociate pointer
@ -262,6 +260,7 @@ function grid_mech_spectral_basic_solution(incInfoIn) result(solution)
solution%iterationsNeeded = totalIter
solution%termIll = terminallyIll
terminallyIll = .false.
P_aim = merge(P_aim,P_av,params%stress_mask)
end function grid_mech_spectral_basic_solution
@ -269,32 +268,25 @@ end function grid_mech_spectral_basic_solution
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,&
subroutine grid_mech_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
deformation_BC,stress_BC,rotation_BC)
logical, intent(in) :: &
logical, intent(in) :: &
cutBack, &
guess
real(pReal), intent(in) :: &
timeinc_old, &
timeinc, &
loadCaseTime !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: &
real(pReal), intent(in) :: &
Delta_t_old, &
Delta_t, &
t_remaining !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: &
stress_BC, &
deformation_BC
type(rotation), intent(in) :: &
type(rotation), intent(in) :: &
rotation_BC
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: F
!--------------------------------------------------------------------------------------------------
! set module wide available data
params%stress_mask = stress_BC%mask
params%rotation_BC = rotation_BC
params%timeinc = timeinc
params%timeincOld = timeinc_old
call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
@ -305,7 +297,7 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,lo
C_volAvgLastInc = C_volAvg
C_minMaxAvgLastInc = C_minMaxAvg
F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)
F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) ! estimate deformation rate for prescribed stress components
F_aim_lastInc = F_aim
!-----------------------------------------------------------------------------------------------
@ -313,40 +305,45 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,lo
if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F
F_aimDot = F_aimDot &
+ merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask)
elseif(deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
+ merge(deformation_BC%values,.0_pReal,deformation_BC%mask)
elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed
F_aimDot = F_aimDot &
+ merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask)
+ merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask)
endif
Fdot = utilities_calculateRate(guess, &
F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, &
F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, &
rotation_BC%rotate(F_aimDot,active=.true.))
F_lastInc = reshape(F,[3,3,grid(1),grid(2),grid3])
homogenization_F0 = reshape(F, [3,3,1,product(grid(1:2))*grid3])
homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3])
endif
!--------------------------------------------------------------------------------------------------
! update average and local deformation gradients
F_aim = F_aim_lastInc + F_aimDot * timeinc
if (stress_BC%myType=='P') then
P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask)
elseif (stress_BC%myType=='dot_P') then !UNTESTED
P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask)
endif
F = reshape(utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average
F_aim = F_aim_lastInc + F_aimDot * Delta_t
if (stress_BC%myType=='P') P_aim = P_aim &
+ merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t
if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t
F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
rotation_BC%rotate(F_aim,active=.true.)),[9,grid(1),grid(2),grid3])
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! set module wide available data
params%stress_mask = stress_BC%mask
params%rotation_BC = rotation_BC
params%timeinc = Delta_t
end subroutine grid_mech_spectral_basic_forward
!--------------------------------------------------------------------------------------------------
!> @brief Age
!> @brief Update coordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_basic_updateCoords
@ -378,6 +375,7 @@ subroutine grid_mech_spectral_basic_restartWrite
fileHandle = HDF5_openFile(fileName,'w')
groupHandle = HDF5_addGroup(fileHandle,'solver')
call HDF5_write(groupHandle,P_aim, 'P_aim')
call HDF5_write(groupHandle,F_aim, 'F_aim')
call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc')
call HDF5_write(groupHandle,F_aimDot, 'F_aimDot')
@ -463,7 +461,7 @@ subroutine formResidual(in, F, &
PetscErrorCode :: ierr
call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr)
call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment
@ -472,11 +470,10 @@ subroutine formResidual(in, F, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
if (debugRotation) &
write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim =', transpose(F_aim)
if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
' deformation gradient aim =', transpose(F_aim)
flush(IO_STDOUT)
endif newIteration

119
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -18,7 +18,6 @@ module grid_mech_spectral_polarisation
use math
use rotations
use spectral_utilities
use FEsolving
use config
use homogenization
use discretization_grid
@ -105,8 +104,6 @@ contains
subroutine grid_mech_spectral_polarisation_init
real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: &
FandF_tau, & ! overall pointer to solution data
@ -147,16 +144,16 @@ subroutine grid_mech_spectral_polarisation_init
num%alpha = num_grid%get_asFloat('alpha', defaultVal=1.0_pReal)
num%beta = num_grid%get_asFloat('beta', defaultVal=1.0_pReal)
if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol')
if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol')
if (num%eps_curl_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_curl_atol')
if (num%eps_curl_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_curl_rtol')
if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol')
if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol')
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin')
if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) call IO_error(301,ext_msg='alpha')
if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) call IO_error(301,ext_msg='beta')
if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol')
if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol')
if (num%eps_curl_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_curl_atol')
if (num%eps_curl_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_curl_rtol')
if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol')
if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol')
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin')
if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) call IO_error(301,ext_msg='alpha')
if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) call IO_error(301,ext_msg='beta')
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
@ -211,6 +208,7 @@ subroutine grid_mech_spectral_polarisation_init
fileHandle = HDF5_openFile(fileName)
groupHandle = HDF5_openGroup(fileHandle,'solver')
call HDF5_read(groupHandle,P_aim, 'P_aim')
call HDF5_read(groupHandle,F_aim, 'F_aim')
call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc')
call HDF5_read(groupHandle,F_aimDot, 'F_aimDot')
@ -226,9 +224,9 @@ subroutine grid_mech_spectral_polarisation_init
F_tau_lastInc = 2.0_pReal*F_lastInc
endif restartRead
homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent
homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent
call utilities_updateCoords(reshape(F,shape(F_lastInc)))
call utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
reshape(F,shape(F_lastInc)), & ! target F
0.0_pReal) ! time increment
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) ! deassociate pointer
@ -294,6 +292,7 @@ function grid_mech_spectral_polarisation_solution(incInfoIn) result(solution)
solution%iterationsNeeded = totalIter
solution%termIll = terminallyIll
terminallyIll = .false.
P_aim = merge(P_aim,P_av,params%stress_mask)
end function grid_mech_spectral_polarisation_solution
@ -301,34 +300,27 @@ end function grid_mech_spectral_polarisation_solution
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,&
subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
deformation_BC,stress_BC,rotation_BC)
logical, intent(in) :: &
logical, intent(in) :: &
cutBack, &
guess
real(pReal), intent(in) :: &
timeinc_old, &
timeinc, &
loadCaseTime !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: &
real(pReal), intent(in) :: &
Delta_t_old, &
Delta_t, &
t_remaining !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: &
stress_BC, &
deformation_BC
type(rotation), intent(in) :: &
type(rotation), intent(in) :: &
rotation_BC
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: FandF_tau, F, F_tau
integer :: i, j, k
real(pReal), dimension(3,3) :: F_lambda33
!--------------------------------------------------------------------------------------------------
! set module wide available data
params%stress_mask = stress_BC%mask
params%rotation_BC = rotation_BC
params%timeinc = timeinc
params%timeincOld = timeinc_old
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)
F => FandF_tau(0: 8,:,:,:)
@ -341,7 +333,7 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc
C_volAvgLastInc = C_volAvg
C_minMaxAvgLastInc = C_minMaxAvg
F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)
F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) ! estimate deformation rate for prescribed stress components
F_aim_lastInc = F_aim
!-----------------------------------------------------------------------------------------------
@ -349,60 +341,63 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc
if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F
F_aimDot = F_aimDot &
+ merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask)
elseif(deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
+ merge(deformation_BC%values,.0_pReal,deformation_BC%mask)
elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed
F_aimDot = F_aimDot &
+ merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask)
+ merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask)
endif
Fdot = utilities_calculateRate(guess, &
F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, &
F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, &
rotation_BC%rotate(F_aimDot,active=.true.))
F_tauDot = utilities_calculateRate(guess, &
F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid3]), timeinc_old, &
F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid3]), Delta_t_old, &
rotation_BC%rotate(F_aimDot,active=.true.))
F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3])
F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3])
homogenization_F0 = reshape(F,[3,3,1,product(grid(1:2))*grid3])
homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3])
endif
!--------------------------------------------------------------------------------------------------
! update average and local deformation gradients
F_aim = F_aim_lastInc + F_aimDot * timeinc
if (stress_BC%myType=='P') then
P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask)
elseif (stress_BC%myType=='dot_P') then !UNTESTED
P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask)
endif
F_aim = F_aim_lastInc + F_aimDot * Delta_t
if(stress_BC%myType=='P') P_aim = P_aim &
+ merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t
if(stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t
F = reshape(utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average
F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
rotation_BC%rotate(F_aim,active=.true.)),&
[9,grid(1),grid(2),grid3])
if (guess) then
F_tau = reshape(Utilities_forwardField(timeinc,F_tau_lastInc,F_taudot), &
F_tau = reshape(Utilities_forwardField(Delta_t,F_tau_lastInc,F_taudot), &
[9,grid(1),grid(2),grid3]) ! does not have any average value as boundary condition
else
do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1)
F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3])
F_lambda33 = math_mul3333xx33(S_scale,matmul(F_lambda33, &
math_mul3333xx33(C_scale,&
matmul(transpose(F_lambda33),&
F_lambda33)-math_I3))*0.5_pReal) &
+ math_I3
F_lambda33 = math_I3 &
+ math_mul3333xx33(S_scale,0.5_pReal*matmul(F_lambda33, &
math_mul3333xx33(C_scale,matmul(transpose(F_lambda33),F_lambda33)-math_I3)))
F_tau(1:9,i,j,k) = reshape(F_lambda33,[9])+F(1:9,i,j,k)
enddo; enddo; enddo
endif
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! set module wide available data
params%stress_mask = stress_BC%mask
params%rotation_BC = rotation_BC
params%timeinc = Delta_t
end subroutine grid_mech_spectral_polarisation_forward
!--------------------------------------------------------------------------------------------------
!> @brief Age
!> @brief Update coordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_polarisation_updateCoords
@ -436,6 +431,7 @@ subroutine grid_mech_spectral_polarisation_restartWrite
fileHandle = HDF5_openFile(fileName,'w')
groupHandle = HDF5_addGroup(fileHandle,'solver')
call HDF5_write(groupHandle,F_aim, 'P_aim')
call HDF5_write(groupHandle,F_aim, 'F_aim')
call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc')
call HDF5_write(groupHandle,F_aimDot, 'F_aimDot')
@ -480,11 +476,11 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
divTol = max(maxval(abs(P_av)) *num%eps_div_rtol ,num%eps_div_atol)
BCTol = max(maxval(abs(P_av)) *num%eps_stress_rtol,num%eps_stress_atol)
if ((totalIter >= num%itmin .and. &
all([ err_div /divTol, &
err_curl/curlTol, &
err_BC /BCTol ] < 1.0_pReal)) &
.or. terminallyIll) then
if (terminallyIll .or. &
(totalIter >= num%itmin .and. &
all([ err_div /divTol, &
err_curl/curlTol, &
err_BC /BCTol ] < 1.0_pReal))) then
reason = 1
elseif (totalIter >= num%itmax) then
reason = -1
@ -555,11 +551,10 @@ subroutine formResidual(in, FandF_tau, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
if(debugRotation) &
write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim =', transpose(F_aim)
if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
' deformation gradient aim =', transpose(F_aim)
flush(IO_STDOUT)
endif newIteration
@ -608,7 +603,7 @@ subroutine formResidual(in, FandF_tau, &
do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1)
e = e + 1
residual_F(1:3,1:3,i,j,k) = &
math_mul3333xx33(math_invSym3333(homogenization_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), &
math_mul3333xx33(math_invSym3333(homogenization_dPdF(1:3,1:3,1:3,1:3,e) + C_scale), &
residual_F(1:3,1:3,i,j,k) - matmul(F(1:3,1:3,i,j,k), &
math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3))) &
+ residual_F_tau(1:3,1:3,i,j,k)

10
src/grid/grid_thermal_spectral.f90
View File

@ -131,8 +131,7 @@ subroutine grid_thermal_spectral_init
cell = 0
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
T_current(i,j,k) = temperature(material_homogenizationAt(cell))% &
p(thermalMapping(material_homogenizationAt(cell))%p(1,cell))
T_current(i,j,k) = temperature(material_homogenizationAt(cell))%p(material_homogenizationMemberAt(1,cell))
T_lastInc(i,j,k) = T_current(i,j,k)
T_stagInc(i,j,k) = T_current(i,j,k)
enddo; enddo; enddo
@ -197,8 +196,7 @@ function grid_thermal_spectral_solution(timeinc) result(solution)
call VecMax(solution_vec,devNull,T_max,ierr); CHKERRQ(ierr)
if (solution%converged) &
print'(/,a)', ' ... thermal conduction converged ..................................'
write(IO_STDOUT,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
T_min, T_max, stagNorm
print'(/,a,f8.4,2x,f8.4,2x,f8.4)', ' Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm
print'(/,a)', ' ==========================================================================='
flush(IO_STDOUT)
@ -258,7 +256,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
PetscObject :: dummy
PetscErrorCode :: ierr
integer :: i, j, k, cell
real(pReal) :: Tdot, dTdot_dT
real(pReal) :: Tdot
T_current = x_scal
!--------------------------------------------------------------------------------------------------
@ -280,7 +278,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
cell = 0
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
cell = cell + 1
call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T_current(i,j,k), 1, cell)
call thermal_conduction_getSource(Tdot, T_current(i,j,k), 1, cell)
scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + Tdot) &
+ thermal_conduction_getMassDensity (1,cell)* &
thermal_conduction_getSpecificHeat(1,cell)*(T_lastInc(i,j,k) - &

43
src/grid/spectral_utilities.f90
View File

@ -93,7 +93,7 @@ module spectral_utilities
real(pReal), dimension(3,3) :: stress_BC
logical, dimension(3,3) :: stress_mask
type(rotation) :: rotation_BC
real(pReal) :: timeinc, timeincOld
real(pReal) :: timeinc
end type tSolutionParams
type :: tNumerics
@ -688,8 +688,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
if(debugGeneral) then
print'(/,a)', ' ... updating masked compliance ............................................'
write(IO_STDOUT,'(/,a,/,9(9(2x,f12.7,1x)/))',advance='no') ' Stiffness C (load) / GPa =',&
transpose(temp99_Real)*1.0e-9_pReal
print'(/,a,/,8(9(2x,f12.7,1x)/),9(2x,f12.7,1x))', &
' Stiffness C (load) / GPa =', transpose(temp99_Real)*1.0e-9_pReal
flush(IO_STDOUT)
endif
@ -709,9 +709,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
if (debugGeneral .or. errmatinv) then
write(formatString, '(i2)') size_reduced
formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
write(IO_STDOUT,trim(formatString),advance='no') ' C * S (load) ', &
transpose(matmul(c_reduced,s_reduced))
write(IO_STDOUT,trim(formatString),advance='no') ' S (load) ', transpose(s_reduced)
print trim(formatString), ' C * S (load) ', transpose(matmul(c_reduced,s_reduced))
print trim(formatString), ' S (load) ', transpose(s_reduced)
if(errmatinv) error stop 'matrix inversion error'
endif
temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pReal),[9,9])
@ -722,7 +721,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
utilities_maskedCompliance = math_99to3333(temp99_Real)
if(debugGeneral) then
write(IO_STDOUT,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') &
print'(/,a,/,9(9(2x,f10.5,1x)/),9(2x,f10.5,1x))', &
' Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal
flush(IO_STDOUT)
endif
@ -811,20 +810,18 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
print'(/,a)', ' ... evaluating constitutive response ......................................'
flush(IO_STDOUT)
homogenization_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field
homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field
call materialpoint_stressAndItsTangent(timeinc) ! calculate P field
call materialpoint_stressAndItsTangent(timeinc,[1,1],[1,product(grid(1:2))*grid3]) ! calculate P field
P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3])
P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P
call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if (debugRotation) &
write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',&
transpose(P_av)*1.e-6_pReal
if(present(rotation_BC)) &
P_av = rotation_BC%rotate(P_av)
write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',&
transpose(P_av)*1.e-6_pReal
if (debugRotation) print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
' Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal
if(present(rotation_BC)) P_av = rotation_BC%rotate(P_av)
print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
' Piola--Kirchhoff stress / MPa =', transpose(P_av)*1.e-6_pReal
flush(IO_STDOUT)
dPdF_max = 0.0_pReal
@ -832,13 +829,13 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
dPdF_min = huge(1.0_pReal)
dPdF_norm_min = huge(1.0_pReal)
do i = 1, product(grid(1:2))*grid3
if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)) then
dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)
dPdF_norm_max = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)
if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)) then
dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,i)
dPdF_norm_max = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)
endif
if (dPdF_norm_min > sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)) then
dPdF_min = homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)
dPdF_norm_min = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)
if (dPdF_norm_min > sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)) then
dPdF_min = homogenization_dPdF(1:3,1:3,1:3,1:3,i)
dPdF_norm_min = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)
endif
end do
@ -856,7 +853,7 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
C_minmaxAvg = 0.5_pReal*(dPdF_max + dPdF_min)
C_volAvg = sum(sum(homogenization_dPdF,dim=6),dim=5)
C_volAvg = sum(homogenization_dPdF,dim=5)
call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if (ierr /= 0) error stop 'MPI error'
C_volAvg = C_volAvg * wgt

653
src/homogenization.f90
View File

@ -11,15 +11,12 @@ module homogenization
use math
use material
use constitutive
use crystallite
use FEsolving
use discretization
use thermal_isothermal
use thermal_adiabatic
use thermal_conduction
use damage_none
use damage_local
use damage_nonlocal
use HDF5_utilities
use results
implicit none
@ -30,14 +27,18 @@ module homogenization
!--------------------------------------------------------------------------------------------------
! General variables for the homogenization at a material point
real(pReal), dimension(:,:,:,:), allocatable, public :: &
homogenization_F0, & !< def grad of IP at start of FE increment
homogenization_F !< def grad of IP to be reached at end of FE increment
real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
homogenization_P !< first P--K stress of IP
real(pReal), dimension(:,:,:,:,:,:), allocatable, public, protected :: &
homogenization_dPdF !< tangent of first P--K stress at IP
real(pReal), dimension(:), allocatable, public :: &
homogenization_T
real(pReal), dimension(:,:,:), allocatable, public :: &
homogenization_F0, & !< def grad of IP at start of FE increment
homogenization_F !< def grad of IP to be reached at end of FE increment
real(pReal), dimension(:,:,:), allocatable, public :: & !, protected :: & Issue with ifort
homogenization_P !< first P--K stress of IP
real(pReal), dimension(:,:,:,:,:), allocatable, public :: & !, protected :: &
homogenization_dPdF !< tangent of first P--K stress at IP
!--------------------------------------------------------------------------------------------------
type :: tNumerics
integer :: &
nMPstate !< materialpoint state loop limit
@ -49,91 +50,64 @@ module homogenization
type(tNumerics) :: num
type :: tDebugOptions
logical :: &
basic, &
extensive, &
selective
integer :: &
element, &
ip, &
grain
end type tDebugOptions
type(tDebugOptions) :: debugHomog
!--------------------------------------------------------------------------------------------------
interface
module subroutine mech_none_init
end subroutine mech_none_init
module subroutine mech_isostrain_init
end subroutine mech_isostrain_init
module subroutine mech_RGC_init(num_homogMech)
module subroutine mech_init(num_homog)
class(tNode), pointer, intent(in) :: &
num_homogMech !< pointer to mechanical homogenization numerics data
end subroutine mech_RGC_init
num_homog !< pointer to mechanical homogenization numerics data
end subroutine mech_init
module subroutine thermal_init
end subroutine thermal_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
real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses
real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
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
module subroutine mech_partition(subF,ip,el)
real(pReal), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ip, & !< integration point
el !< element number
end function mech_RGC_updateState
end subroutine mech_partition
module subroutine thermal_partition(T,ip,el)
real(pReal), intent(in) :: T
integer, intent(in) :: &
ip, & !< integration point
el !< element number
end subroutine thermal_partition
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
module subroutine mech_homogenize(dt,ip,el)
real(pReal), intent(in) :: dt
integer, intent(in) :: &
ip, & !< integration point
el !< element number
end subroutine mech_homogenize
module subroutine mech_results(group_base,h)
character(len=*), intent(in) :: group_base
integer, intent(in) :: h
end subroutine mech_results
module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy)
real(pReal), intent(in) :: &
subdt !< current time step
real(pReal), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ip, & !< integration point
el !< element number
logical, dimension(2) :: doneAndHappy
end function mech_updateState
end interface
public :: &
homogenization_init, &
materialpoint_stressAndItsTangent, &
homogenization_results
homogenization_forward, &
homogenization_results, &
homogenization_restartRead, &
homogenization_restartWrite
contains
@ -145,49 +119,13 @@ subroutine homogenization_init
class (tNode) , pointer :: &
num_homog, &
num_homogMech, &
num_homogGeneric, &
debug_homogenization
debug_homogenization => config_debug%get('homogenization', defaultVal=emptyList)
debugHomog%basic = debug_homogenization%contains('basic')
debugHomog%extensive = debug_homogenization%contains('extensive')
debugHomog%selective = debug_homogenization%contains('selective')
debugHomog%element = config_debug%get_asInt('element',defaultVal = 1)
debugHomog%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1)
debugHomog%grain = config_debug%get_asInt('grain',defaultVal = 1)
if (debugHomog%grain < 1 &
.or. debugHomog%grain > homogenization_Nconstituents(material_homogenizationAt(debugHomog%element))) &
call IO_error(602,ext_msg='constituent', el=debugHomog%element, g=debugHomog%grain)
num_homog => config_numerics%get('homogenization',defaultVal=emptyDict)
num_homogMech => num_homog%get('mech',defaultVal=emptyDict)
num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict)
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 mech_RGC_init(num_homogMech)
if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init
if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init
if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init
if (any(damage_type == DAMAGE_none_ID)) call damage_none_init
if (any(damage_type == DAMAGE_local_ID)) call damage_local_init
if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init
!--------------------------------------------------------------------------------------------------
! allocate and initialize global variables
allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal)
homogenization_F0 = spread(spread(math_I3,3,discretization_nIPs),4,discretization_Nelems) ! initialize to identity
homogenization_F = homogenization_F0 ! initialize to identity
allocate(homogenization_P(3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal)
num_homogGeneric
print'(/,a)', ' <<<+- homogenization init -+>>>'; flush(IO_STDOUT)
num_homog => config_numerics%get('homogenization',defaultVal=emptyDict)
num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict)
num%nMPstate = num_homogGeneric%get_asInt ('nMPstate', defaultVal=10)
num%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal)
num%subStepSizeHomog = num_homogGeneric%get_asFloat('subStepSize', defaultVal=0.25_pReal)
@ -198,190 +136,141 @@ subroutine homogenization_init
if (num%subStepSizeHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeHomog')
if (num%stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog')
call mech_init(num_homog)
call thermal_init()
if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init(homogenization_T)
if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init(homogenization_T)
if (any(damage_type == DAMAGE_none_ID)) call damage_none_init
if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init
end subroutine homogenization_init
!--------------------------------------------------------------------------------------------------
!> @brief parallelized calculation of stress and corresponding tangent at material points
!--------------------------------------------------------------------------------------------------
subroutine materialpoint_stressAndItsTangent(dt)
subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execElem)
real(pReal), intent(in) :: dt !< time increment
integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP
integer :: &
NiterationHomog, &
NiterationMPstate, &
i, & !< integration point number
e, & !< element number
myNgrains
real(pReal), dimension(discretization_nIPs,discretization_Nelems) :: &
ip, & !< integration point number
el, & !< element number
myNgrains, co, ce, ho, me
real(pReal) :: &
subFrac, &
subStep
logical, dimension(discretization_nIPs,discretization_Nelems) :: &
requested, &
logical :: &
converged
logical, dimension(2,discretization_nIPs,discretization_Nelems) :: &
logical, dimension(2) :: &
doneAndHappy
!$OMP PARALLEL DO PRIVATE(ce,me,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy)
do el = FEsolving_execElem(1),FEsolving_execElem(2)
ho = material_homogenizationAt(el)
myNgrains = homogenization_Nconstituents(ho)
do ip = FEsolving_execIP(1),FEsolving_execIP(2)
me = material_homogenizationMemberAt(ip,el)
!--------------------------------------------------------------------------------------------------
! initialize restoration points
do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1),FEsolving_execIP(2);
call constitutive_initializeRestorationPoints(ip,el)
call crystallite_initializeRestorationPoints(i,e)
subFrac = 0.0_pReal
converged = .false. ! pretend failed step ...
subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation
subFrac(i,e) = 0.0_pReal
converged(i,e) = .false. ! pretend failed step ...
subStep(i,e) = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation
requested(i,e) = .true. ! everybody requires calculation
if (homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me)
if (damageState_h(ho)%sizeState > 0) damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State0(:,me)
if (homogState(material_homogenizationAt(e))%sizeState > 0) &
homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
homogState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e))
cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog)
if (thermalState(material_homogenizationAt(e))%sizeState > 0) &
thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
thermalState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e))
if (converged) then
subFrac = subFrac + subStep
subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep) ! introduce flexibility for step increase/acceleration
if (damageState(material_homogenizationAt(e))%sizeState > 0) &
damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
damageState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e))
enddo
enddo
NiterationHomog = 0
cutBackLooping: do while (.not. terminallyIll .and. &
any(subStep(FEsolving_execIP(1):FEsolving_execIP(2),&
FEsolving_execElem(1):FEsolving_execElem(2)) > num%subStepMinHomog))
!$OMP PARALLEL DO
elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Nconstituents(material_homogenizationAt(e))
IpLooping1: do i = FEsolving_execIP(1),FEsolving_execIP(2)
if (converged(i,e)) then
subFrac(i,e) = subFrac(i,e) + subStep(i,e)
subStep(i,e) = min(1.0_pReal-subFrac(i,e),num%stepIncreaseHomog*subStep(i,e)) ! introduce flexibility for step increase/acceleration
steppingNeeded: if (subStep(i,e) > num%subStepMinHomog) then
steppingNeeded: if (subStep > num%subStepMinHomog) then
! wind forward grain starting point
call crystallite_windForward(i,e)
call constitutive_windForward(ip,el)
if(homogState(material_homogenizationAt(e))%sizeState > 0) &
homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
homogState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e))
if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
thermalState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e))
if(damageState(material_homogenizationAt(e))%sizeState > 0) &
damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
damageState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e))
if(homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me)
if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State(:,me)
endif steppingNeeded
else
if ( (myNgrains == 1 .and. subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite
num%subStepSizeHomog * subStep(i,e) <= num%subStepMinHomog ) then ! would require too small subStep
elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite
num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep
! cutback makes no sense
if (.not. terminallyIll) then ! so first signals terminally ill...
print*, ' Integration point ', i,' at element ', e, ' terminally ill'
endif
terminallyIll = .true. ! ...and kills all others
else ! cutback makes sense
subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback
if (.not. terminallyIll) & ! so first signals terminally ill...
print*, ' Integration point ', ip,' at element ', el, ' terminally ill'
terminallyIll = .true. ! ...and kills all others
else ! cutback makes sense
subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback
call crystallite_restore(i,e,subStep(i,e) < 1.0_pReal)
call constitutive_restore(ip,el,subStep < 1.0_pReal)
if(homogState(material_homogenizationAt(e))%sizeState > 0) &
homogState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = &
homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e))
if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
thermalState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = &
thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e))
if(damageState(material_homogenizationAt(e))%sizeState > 0) &
damageState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = &
damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e))
endif
if(homogState(ho)%sizeState > 0) homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me)
if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%State(:,me) = damageState_h(ho)%subState0(:,me)
endif
if (subStep(i,e) > num%subStepMinHomog) then
requested(i,e) = .true.
doneAndHappy(1:2,i,e) = [.false.,.true.]
endif
enddo IpLooping1
enddo elementLooping1
!$OMP END PARALLEL DO
if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.]
NiterationMPstate = 0
convergenceLooping: do while (.not. terminallyIll .and. &
any( requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) &
.and. .not. doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) &
) .and. &
NiterationMPstate < num%nMPstate)
NiterationMPstate = NiterationMPstate + 1
NiterationMPstate = 0
convergenceLooping: do while (.not. terminallyIll &
.and. .not. doneAndHappy(1) &
.and. NiterationMPstate < num%nMPstate)
NiterationMPstate = NiterationMPstate + 1
!--------------------------------------------------------------------------------------------------
! deformation partitioning
!$OMP PARALLEL DO PRIVATE(myNgrains)
elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Nconstituents(material_homogenizationAt(e))
IpLooping2: do i = FEsolving_execIP(1),FEsolving_execIP(2)
if(requested(i,e) .and. .not. doneAndHappy(1,i,e)) then ! requested but not yet done
call partitionDeformation(homogenization_F0(1:3,1:3,i,e) &
+ (homogenization_F(1:3,1:3,i,e)-homogenization_F0(1:3,1:3,i,e))&
*(subStep(i,e)+subFrac(i,e)), &
i,e)
crystallite_dt(1:myNgrains,i,e) = dt*subStep(i,e) ! propagate materialpoint dt to grains
crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents
else
crystallite_requested(1:myNgrains,i,e) = .false. ! calculation for constituents not required anymore
endif
enddo IpLooping2
enddo elementLooping2
!$OMP END PARALLEL DO
!--------------------------------------------------------------------------------------------------
! crystallite integration
converged = crystallite_stress() !ToDo: MD not sure if that is the best logic
if (.not. doneAndHappy(1)) then
ce = (el-1)*discretization_nIPs + ip
call mech_partition(homogenization_F0(1:3,1:3,ce) &
+ (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))&
*(subStep+subFrac), &
ip,el)
converged = .true.
do co = 1, myNgrains
converged = converged .and. crystallite_stress(dt*subStep,co,ip,el)
enddo
!--------------------------------------------------------------------------------------------------
! state update
!$OMP PARALLEL DO
elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2)
IpLooping3: do i = FEsolving_execIP(1),FEsolving_execIP(2)
if (requested(i,e) .and. .not. doneAndHappy(1,i,e)) then
if (.not. converged(i,e)) then
doneAndHappy(1:2,i,e) = [.true.,.false.]
if (.not. converged) then
doneAndHappy = [.true.,.false.]
else
doneAndHappy(1:2,i,e) = updateState(dt*subStep(i,e), &
homogenization_F0(1:3,1:3,i,e) &
+ (homogenization_F(1:3,1:3,i,e)-homogenization_F0(1:3,1:3,i,e)) &
*(subStep(i,e)+subFrac(i,e)), &
i,e)
converged(i,e) = all(doneAndHappy(1:2,i,e)) ! converged if done and happy
ce = (el-1)*discretization_nIPs + ip
doneAndHappy = mech_updateState(dt*subStep, &
homogenization_F0(1:3,1:3,ce) &
+ (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) &
*(subStep+subFrac), &
ip,el)
converged = all(doneAndHappy)
endif
endif
enddo IpLooping3
enddo elementLooping3
!$OMP END PARALLEL DO
enddo convergenceLooping
NiterationHomog = NiterationHomog + 1
enddo cutBackLooping
enddo convergenceLooping
enddo cutBackLooping
enddo
enddo
!$OMP END PARALLEL DO
if (.not. terminallyIll ) then
call crystallite_orientations() ! calculate crystal orientations
!$OMP PARALLEL DO
elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2)
IpLooping4: do i = FEsolving_execIP(1),FEsolving_execIP(2)
call averageStressAndItsTangent(i,e)
enddo IpLooping4
enddo elementLooping4
!$OMP PARALLEL DO PRIVATE(ho,myNgrains)
elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2)
ho = material_homogenizationAt(el)
myNgrains = homogenization_Nconstituents(ho)
IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2)
do co = 1, myNgrains
call crystallite_orientations(co,ip,el)
enddo
call mech_homogenize(dt,ip,el)
enddo IpLooping3
enddo elementLooping3
!$OMP END PARALLEL DO
else
print'(/,a,/)', ' << HOMOG >> Material Point terminally ill'
@ -390,189 +279,111 @@ subroutine materialpoint_stressAndItsTangent(dt)
end subroutine materialpoint_stressAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief partition material point def grad onto constituents
!--------------------------------------------------------------------------------------------------
subroutine partitionDeformation(subF,ip,el)
real(pReal), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ip, & !< integration point
el !< element number
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
crystallite_partitionedF(1:3,1:3,1,ip,el) = subF
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
call mech_isostrain_partitionDeformation(&
crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
subF)
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call mech_RGC_partitionDeformation(&
crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
subF,&
ip, &
el)
end select chosenHomogenization
end subroutine partitionDeformation
!--------------------------------------------------------------------------------------------------
!> @brief update the internal state of the homogenization scheme and tell whether "done" and
!> "happy" with result
!--------------------------------------------------------------------------------------------------
function updateState(subdt,subF,ip,el)
real(pReal), intent(in) :: &
subdt !< current time step
real(pReal), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ip, & !< integration point
el !< element number
integer :: c
logical, dimension(2) :: updateState
real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
updateState = .true.
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
do c=1,homogenization_Nconstituents(material_homogenizationAt(el))
dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el)
enddo
updateState = &
updateState .and. &
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),&
subF,&
subdt, &
dPdFs, &
ip, &
el)
end select chosenHomogenization
chosenThermal: select case (thermal_type(material_homogenizationAt(el)))
case (THERMAL_adiabatic_ID) chosenThermal
updateState = &
updateState .and. &
thermal_adiabatic_updateState(subdt, &
ip, &
el)
end select chosenThermal
chosenDamage: select case (damage_type(material_homogenizationAt(el)))
case (DAMAGE_local_ID) chosenDamage
updateState = &
updateState .and. &
damage_local_updateState(subdt, &
ip, &
el)
end select chosenDamage
end function updateState
!--------------------------------------------------------------------------------------------------
!> @brief derive average stress and stiffness from constituent quantities
!--------------------------------------------------------------------------------------------------
subroutine averageStressAndItsTangent(ip,el)
integer, intent(in) :: &
ip, & !< integration point
el !< element number
integer :: c
real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
homogenization_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el)
homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_stressTangent(1,ip,el)
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
do c = 1, homogenization_Nconstituents(material_homogenizationAt(el))
dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el)
enddo
call mech_isostrain_averageStressAndItsTangent(&
homogenization_P(1:3,1:3,ip,el), &
homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),&
crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
dPdFs, &
homogenization_typeInstance(material_homogenizationAt(el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
do c = 1, homogenization_Nconstituents(material_homogenizationAt(el))
dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el)
enddo
call mech_RGC_averageStressAndItsTangent(&
homogenization_P(1:3,1:3,ip,el), &
homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),&
crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
dPdFs, &
homogenization_typeInstance(material_homogenizationAt(el)))
end select chosenHomogenization
end subroutine averageStressAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief writes homogenization results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine homogenization_results
use material, only: &
material_homogenization_type => homogenization_type
integer :: p
integer :: ho
character(len=:), allocatable :: group_base,group
!real(pReal), dimension(:,:,:), allocatable :: temp
do p=1,size(material_name_homogenization)
group_base = 'current/homogenization/'//trim(material_name_homogenization(p))
call results_closeGroup(results_addGroup('current/homogenization/'))
do ho=1,size(material_name_homogenization)
group_base = 'current/homogenization/'//trim(material_name_homogenization(ho))
call results_closeGroup(results_addGroup(group_base))
group = trim(group_base)//'/generic'
call results_closeGroup(results_addGroup(group))
!temp = reshape(homogenization_F,[3,3,discretization_nIPs*discretization_Nelems])
!call results_writeDataset(group,temp,'F',&
! 'deformation gradient','1')
!temp = reshape(homogenization_P,[3,3,discretization_nIPs*discretization_Nelems])
!call results_writeDataset(group,temp,'P',&
! '1st Piola-Kirchhoff stress','Pa')
group = trim(group_base)//'/mech'
call results_closeGroup(results_addGroup(group))
select case(material_homogenization_type(p))
case(HOMOGENIZATION_rgc_ID)
call mech_RGC_results(homogenization_typeInstance(p),group)
end select
call mech_results(group_base,ho)
group = trim(group_base)//'/damage'
call results_closeGroup(results_addGroup(group))
select case(damage_type(p))
case(DAMAGE_LOCAL_ID)
call damage_local_results(p,group)
select case(damage_type(ho))
case(DAMAGE_NONLOCAL_ID)
call damage_nonlocal_results(p,group)
call damage_nonlocal_results(ho,group)
end select
group = trim(group_base)//'/thermal'
call results_closeGroup(results_addGroup(group))
select case(thermal_type(p))
case(THERMAL_ADIABATIC_ID)
call thermal_adiabatic_results(p,group)
select case(thermal_type(ho))
case(THERMAL_CONDUCTION_ID)
call thermal_conduction_results(p,group)
call thermal_conduction_results(ho,group)
end select
enddo
end subroutine homogenization_results
!--------------------------------------------------------------------------------------------------
!> @brief Forward data after successful increment.
! ToDo: Any guessing for the current states possible?
!--------------------------------------------------------------------------------------------------
subroutine homogenization_forward
integer :: ho
do ho = 1, size(material_name_homogenization)
homogState (ho)%state0 = homogState (ho)%state
damageState_h(ho)%state0 = damageState_h(ho)%state
enddo
end subroutine homogenization_forward
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine homogenization_restartWrite(fileHandle)
integer(HID_T), intent(in) :: fileHandle
integer(HID_T), dimension(2) :: groupHandle
integer :: ho
groupHandle(1) = HDF5_addGroup(fileHandle,'homogenization')
do ho = 1, size(material_name_homogenization)
groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_homogenization(ho))
call HDF5_read(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech
call HDF5_closeGroup(groupHandle(2))
enddo
call HDF5_closeGroup(groupHandle(1))
end subroutine homogenization_restartWrite
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine homogenization_restartRead(fileHandle)
integer(HID_T), intent(in) :: fileHandle
integer(HID_T), dimension(2) :: groupHandle
integer :: ho
groupHandle(1) = HDF5_openGroup(fileHandle,'homogenization')
do ho = 1, size(material_name_homogenization)
groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_homogenization(ho))
call HDF5_write(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech
call HDF5_closeGroup(groupHandle(2))
enddo
call HDF5_closeGroup(groupHandle(1))
end subroutine homogenization_restartRead
end module homogenization

256
src/homogenization_mech.f90 Normal file
View File

@ -0,0 +1,256 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, KU Leuven
!> @brief Partition F and homogenize P/dPdF
!--------------------------------------------------------------------------------------------------
submodule(homogenization) homogenization_mech
interface
module subroutine mech_none_init
end subroutine mech_none_init
module subroutine mech_isostrain_init
end subroutine mech_isostrain_init
module subroutine mech_RGC_init(num_homogMech)
class(tNode), pointer, intent(in) :: &
num_homogMech !< pointer to mechanical homogenization numerics data
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
real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses
real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
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,avgF,dt,dPdF,ip,el) result(doneAndHappy)
logical, dimension(2) :: doneAndHappy
real(pReal), dimension(:,:,:), intent(in) :: &
P,& !< partitioned stresses
F !< partitioned 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
contains
!--------------------------------------------------------------------------------------------------
!> @brief Allocate variables and set parameters.
!--------------------------------------------------------------------------------------------------
module subroutine mech_init(num_homog)
class(tNode), pointer, intent(in) :: &
num_homog
class(tNode), pointer :: &
num_homogMech
print'(/,a)', ' <<<+- homogenization_mech init -+>>>'
allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal)
homogenization_F0 = spread(math_I3,3,discretization_nIPs*discretization_Nelems) ! initialize to identity
homogenization_F = homogenization_F0 ! initialize to identity
allocate(homogenization_P(3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal)
num_homogMech => num_homog%get('mech',defaultVal=emptyDict)
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 mech_RGC_init(num_homogMech)
end subroutine mech_init
!--------------------------------------------------------------------------------------------------
!> @brief Partition F onto the individual constituents.
!--------------------------------------------------------------------------------------------------
module subroutine mech_partition(subF,ip,el)
real(pReal), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ip, & !< integration point
el !< element number
integer :: co
real(pReal), dimension (3,3,homogenization_Nconstituents(material_homogenizationAt(el))) :: Fs
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
Fs(1:3,1:3,1) = subF
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
call mech_isostrain_partitionDeformation(Fs,subF)
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call mech_RGC_partitionDeformation(Fs,subF,ip,el)
end select chosenHomogenization
do co = 1,homogenization_Nconstituents(material_homogenizationAt(el))
call constitutive_mech_setF(Fs(1:3,1:3,co),co,ip,el)
enddo
end subroutine mech_partition
!--------------------------------------------------------------------------------------------------
!> @brief Average P and dPdF from the individual constituents.
!--------------------------------------------------------------------------------------------------
module subroutine mech_homogenize(dt,ip,el)
real(pReal), intent(in) :: dt
integer, intent(in) :: &
ip, & !< integration point
el !< element number
integer :: co,ce
real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
ce = (el-1)* discretization_nIPs + ip
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
homogenization_P(1:3,1:3,ce) = constitutive_mech_getP(1,ip,el)
homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = constitutive_mech_dPdF(dt,1,ip,el)
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el)
Ps(:,:,co) = constitutive_mech_getP(co,ip,el)
enddo
call mech_isostrain_averageStressAndItsTangent(&
homogenization_P(1:3,1:3,ce), &
homogenization_dPdF(1:3,1:3,1:3,1:3,ce),&
Ps,dPdFs, &
homogenization_typeInstance(material_homogenizationAt(el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el)
Ps(:,:,co) = constitutive_mech_getP(co,ip,el)
enddo
call mech_RGC_averageStressAndItsTangent(&
homogenization_P(1:3,1:3,ce), &
homogenization_dPdF(1:3,1:3,1:3,1:3,ce),&
Ps,dPdFs, &
homogenization_typeInstance(material_homogenizationAt(el)))
end select chosenHomogenization
end subroutine mech_homogenize
!--------------------------------------------------------------------------------------------------
!> @brief update the internal state of the homogenization scheme and tell whether "done" and
!> "happy" with result
!--------------------------------------------------------------------------------------------------
module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy)
real(pReal), intent(in) :: &
subdt !< current time step
real(pReal), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ip, & !< integration point
el !< element number
logical, dimension(2) :: doneAndHappy
integer :: co
real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(subdt,co,ip,el)
Fs(:,:,co) = constitutive_mech_getF(co,ip,el)
Ps(:,:,co) = constitutive_mech_getP(co,ip,el)
enddo
doneAndHappy = mech_RGC_updateState(Ps,Fs,subF,subdt,dPdFs,ip,el)
else
doneAndHappy = .true.
endif
end function mech_updateState
!--------------------------------------------------------------------------------------------------
!> @brief Write results to file.
!--------------------------------------------------------------------------------------------------
module subroutine mech_results(group_base,h)
use material, only: &
material_homogenization_type => homogenization_type
character(len=*), intent(in) :: group_base
integer, intent(in) :: h
character(len=:), allocatable :: group
group = trim(group_base)//'/mech'
call results_closeGroup(results_addGroup(group))
select case(material_homogenization_type(h))
case(HOMOGENIZATION_rgc_ID)
call mech_RGC_results(homogenization_typeInstance(h),group)
end select
!temp = reshape(homogenization_F,[3,3,discretization_nIPs*discretization_Nelems])
!call results_writeDataset(group,temp,'F',&
! 'deformation gradient','1')
!temp = reshape(homogenization_P,[3,3,discretization_nIPs*discretization_Nelems])
!call results_writeDataset(group,temp,'P',&
! '1st Piola-Kirchhoff stress','Pa')
end subroutine mech_results
end submodule homogenization_mech

291
src/homogenization_mech_RGC.f90
View File

@ -6,8 +6,9 @@
!> @brief Relaxed grain cluster (RGC) homogenization scheme
!> N_constituents is defined as p x q x r (cluster)
!--------------------------------------------------------------------------------------------------
submodule(homogenization) homogenization_mech_RGC
submodule(homogenization:homogenization_mech) homogenization_mech_RGC
use rotations
use lattice
type :: tParameters
integer, dimension(:), allocatable :: &
@ -18,16 +19,11 @@ submodule(homogenization) homogenization_mech_RGC
real(pReal), dimension(:), allocatable :: &
D_alpha, &
a_g
integer :: &
of_debug = 0
character(len=pStringLen), allocatable, dimension(:) :: &
output
end type tParameters
type :: tRGCstate
real(pReal), pointer, dimension(:) :: &
work, &
penaltyEnergy
real(pReal), pointer, dimension(:,:) :: &
relaxationVector
end type tRGCstate
@ -151,12 +147,6 @@ module subroutine mech_RGC_init(num_homogMech)
st0 => state0(homogenization_typeInstance(h)), &
dst => dependentState(homogenization_typeInstance(h)))
#ifdef DEBUG
if (h==material_homogenizationAt(debugHomog%element)) then
prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element)
endif
#endif
#if defined (__GFORTRAN__)
prm%output = output_asStrings(homogMech)
#else
@ -177,8 +167,7 @@ module subroutine mech_RGC_init(num_homogMech)
nIntFaceTot = 3*( (prm%N_constituents(1)-1)*prm%N_constituents(2)*prm%N_constituents(3) &
+ prm%N_constituents(1)*(prm%N_constituents(2)-1)*prm%N_constituents(3) &
+ prm%N_constituents(1)*prm%N_constituents(2)*(prm%N_constituents(3)-1))
sizeState = nIntFaceTot &
+ size(['avg constitutive work ','average penalty energy'])
sizeState = nIntFaceTot
homogState(h)%sizeState = sizeState
allocate(homogState(h)%state0 (sizeState,Nmaterialpoints), source=0.0_pReal)
@ -187,8 +176,6 @@ module subroutine mech_RGC_init(num_homogMech)
stt%relaxationVector => homogState(h)%state(1:nIntFaceTot,:)
st0%relaxationVector => homogState(h)%state0(1:nIntFaceTot,:)
stt%work => homogState(h)%state(nIntFaceTot+1,:)
stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+2,:)
allocate(dst%volumeDiscrepancy( Nmaterialpoints), source=0.0_pReal)
allocate(dst%relaxationRate_avg( Nmaterialpoints), source=0.0_pReal)
@ -239,17 +226,6 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation
enddo
F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient
#ifdef DEBUG
if (debugHomog%extensive) then
print'(a,i3)',' Deformation gradient of grain: ',iGrain
do i = 1,3
print'(1x,3(e15.8,1x))',(F(i,j,iGrain), j = 1,3)
enddo
print*,' '
flush(IO_STDOUT)
endif
#endif
enddo
end associate
@ -261,7 +237,17 @@ end subroutine mech_RGC_partitionDeformation
!> @brief update the internal state of the homogenization scheme and tell whether "done" and
! "happy" with result
!--------------------------------------------------------------------------------------------------
module procedure mech_RGC_updateState
module function mech_RGC_updateState(P,F,avgF,dt,dPdF,ip,el) result(doneAndHappy)
logical, dimension(2) :: doneAndHappy
real(pReal), dimension(:,:,:), intent(in) :: &
P,& !< partitioned stresses
F !< partitioned 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
integer, dimension(4) :: intFaceN,intFaceP,faceID
integer, dimension(3) :: nGDim,iGr3N,iGr3P
@ -273,13 +259,9 @@ module procedure mech_RGC_updateState
logical :: error
real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax
#ifdef DEBUG
integer, dimension(3) :: stresLoc
integer, dimension(2) :: residLoc
#endif
zeroTimeStep: if(dEq0(dt)) then
mech_RGC_updateState = .true. ! pretend everything is fine and return
doneAndHappy = .true. ! pretend everything is fine and return
return
endif zeroTimeStep
@ -298,21 +280,11 @@ module procedure mech_RGC_updateState
!--------------------------------------------------------------------------------------------------
! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster
allocate(resid(3*nIntFaceTot), source=0.0_pReal)
allocate(tract(nIntFaceTot,3), source=0.0_pReal)
allocate(resid(3*nIntFaceTot), source=0.0_pReal)
allocate(tract(nIntFaceTot,3), source=0.0_pReal)
relax = stt%relaxationVector(:,of)
drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of)
#ifdef DEBUG
if (debugHomog%extensive) then
print*, 'Obtained state: '
do i = 1,size(stt%relaxationVector(:,of))
print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of)
enddo
print*,' '
endif
#endif
!--------------------------------------------------------------------------------------------------
! computing interface mismatch and stress penalty tensor for all interfaces of all grains
call stressPenalty(R,NN,avgF,F,ip,el,instance,of)
@ -353,13 +325,6 @@ module procedure mech_RGC_updateState
enddo
enddo
#ifdef DEBUG
if (debugHomog%extensive) then
print'(a,i3)',' Traction at interface: ',iNum
print'(1x,3(e15.8,1x))',(tract(iNum,j), j = 1,3)
print*,' '
endif
#endif
enddo
!--------------------------------------------------------------------------------------------------
@ -367,80 +332,25 @@ module procedure mech_RGC_updateState
stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress
residMax = maxval(abs(tract)) ! get the maximum of the residual
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) then
stresLoc = maxloc(abs(P))
residLoc = maxloc(abs(tract))
print'(a,i2,1x,i4)',' RGC residual check ... ',ip,el
print'(a,e15.8,a,i3,a,i2,i2)', ' Max stress: ',stresMax, &
'@ grain ',stresLoc(3),' in component ',stresLoc(1),stresLoc(2)
print'(a,e15.8,a,i3,a,i2)',' Max residual: ',residMax, &
' @ iface ',residLoc(1),' in direction ',residLoc(2)
flush(IO_STDOUT)
endif
#endif
mech_RGC_updateState = .false.
doneAndHappy = .false.
!--------------------------------------------------------------------------------------------------
! If convergence reached => done and happy
if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
mech_RGC_updateState = .true.
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) &
print*, '... done and happy'; flush(IO_STDOUT)
#endif
!--------------------------------------------------------------------------------------------------
! compute/update the state for postResult, i.e., all energy densities computed by time-integration
do iGrain = 1,product(prm%N_constituents)
do i = 1,3;do j = 1,3
stt%work(of) = stt%work(of) &
+ P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal)
stt%penaltyEnergy(of) = stt%penaltyEnergy(of) &
+ R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal)
enddo; enddo
enddo
doneAndHappy = .true.
dst%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal)
dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal)
dst%relaxationRate_max(of) = maxval(abs(drelax))/dt
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) then
print'(a,e15.8)', ' Constitutive work: ',stt%work(of)
print'(a,3(1x,e15.8))', ' Magnitude mismatch: ',dst%mismatch(1,of), &
dst%mismatch(2,of), &
dst%mismatch(3,of)
print'(a,e15.8)', ' Penalty energy: ', stt%penaltyEnergy(of)
print'(a,e15.8,/)', ' Volume discrepancy: ', dst%volumeDiscrepancy(of)
print'(a,e15.8)', ' Maximum relaxation rate: ', dst%relaxationRate_max(of)
print'(a,e15.8,/)', ' Average relaxation rate: ', dst%relaxationRate_avg(of)
flush(IO_STDOUT)
endif
#endif
return
!--------------------------------------------------------------------------------------------------
! if residual blows-up => done but unhappy
elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then ! try to restart when residual blows up exceeding maximum bound
mech_RGC_updateState = [.true.,.false.] ! with direct cut-back
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) &
print'(a,/)', ' ... broken'; flush(IO_STDOUT)
#endif
doneAndHappy = [.true.,.false.] ! with direct cut-back
return
else ! proceed with computing the Jacobian and state update
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) &
print'(a,/)', ' ... not yet done'; flush(IO_STDOUT)
#endif
endif
endif
!---------------------------------------------------------------------------------------------------
! construct the global Jacobian matrix for updating the global relaxation vector array when
@ -492,17 +402,6 @@ module procedure mech_RGC_updateState
enddo
enddo
#ifdef DEBUG
if (debugHomog%extensive) then
print*, 'Jacobian matrix of stress'
do i = 1,3*nIntFaceTot
print'(1x,100(e11.4,1x))',(smatrix(i,j), j = 1,3*nIntFaceTot)
enddo
print*,' '
flush(IO_STDOUT)
endif
#endif
!--------------------------------------------------------------------------------------------------
! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical
! perturbation method) "pmatrix"
@ -552,16 +451,6 @@ module procedure mech_RGC_updateState
pmatrix(:,ipert) = p_resid/num%pPert
enddo
#ifdef DEBUG
if (debugHomog%extensive) then
print*, 'Jacobian matrix of penalty'
do i = 1,3*nIntFaceTot
print'(1x,100(e11.4,1x))',(pmatrix(i,j), j = 1,3*nIntFaceTot)
enddo
print*,' '
flush(IO_STDOUT)
endif
#endif
!--------------------------------------------------------------------------------------------------
! ... of the numerical viscosity traction "rmatrix"
@ -571,48 +460,16 @@ module procedure mech_RGC_updateState
(abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pReal) ! only in the main diagonal term
enddo
#ifdef DEBUG
if (debugHomog%extensive) then
print*, 'Jacobian matrix of penalty'
do i = 1,3*nIntFaceTot
print'(1x,100(e11.4,1x))',(rmatrix(i,j), j = 1,3*nIntFaceTot)
enddo
print*,' '
flush(IO_STDOUT)
endif
#endif
!--------------------------------------------------------------------------------------------------
! The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix
allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix
#ifdef DEBUG
if (debugHomog%extensive) then
print*, 'Jacobian matrix (total)'
do i = 1,3*nIntFaceTot
print'(1x,100(e11.4,1x))',(jmatrix(i,j), j = 1,3*nIntFaceTot)
enddo
print*,' '
flush(IO_STDOUT)
endif
#endif
!--------------------------------------------------------------------------------------------------
! computing the update of the state variable (relaxation vectors) using the Jacobian matrix
allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
call math_invert(jnverse,error,jmatrix)
#ifdef DEBUG
if (debugHomog%extensive) then
print*, 'Jacobian inverse'
do i = 1,3*nIntFaceTot
print'(1x,100(e11.4,1x))',(jnverse(i,j), j = 1,3*nIntFaceTot)
enddo
print*,' '
flush(IO_STDOUT)
endif
#endif
!--------------------------------------------------------------------------------------------------
! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration
drelax = 0.0_pReal
@ -621,7 +478,7 @@ module procedure mech_RGC_updateState
enddo; enddo
stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration
if (any(abs(drelax) > num%maxdRelax)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large
mech_RGC_updateState = [.true.,.false.]
doneAndHappy = [.true.,.false.]
!$OMP CRITICAL (write2out)
print'(a,i3,a,i3,a)',' RGC_updateState: ip ',ip,' | el ',el,' enforces cutback'
print'(a,e15.8)',' due to large relaxation change = ',maxval(abs(drelax))
@ -629,17 +486,6 @@ module procedure mech_RGC_updateState
!$OMP END CRITICAL (write2out)
endif
#ifdef DEBUG
if (debugHomog%extensive) then
print*, 'Returned state: '
do i = 1,size(stt%relaxationVector(:,of))
print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of)
enddo
print*,' '
flush(IO_STDOUT)
endif
#endif
end associate
contains
@ -659,10 +505,11 @@ module procedure mech_RGC_updateState
integer, dimension (3) :: iGrain3,iGNghb3,nGDim
real(pReal), dimension (3,3) :: gDef,nDef
real(pReal), dimension (3) :: nVect,surfCorr
real(pReal), dimension (2) :: Gmoduli
integer :: iGrain,iGNghb,iFace,i,j,k,l
real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb
real(pReal), parameter :: nDefToler = 1.0e-10_pReal
real(pReal) :: muGrain,muGNghb,nDefNorm
real(pReal), parameter :: &
nDefToler = 1.0e-10_pReal, &
b = 2.5e-10_pReal ! Length of Burgers vector
nGDim = param(instance)%N_constituents
rPen = 0.0_pReal
@ -676,19 +523,11 @@ module procedure mech_RGC_updateState
associate(prm => param(instance))
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) then
print'(a,2(1x,i3))', ' Correction factor: ',ip,el
print*, surfCorr
endif
#endif
!-----------------------------------------------------------------------------------------------
! computing the mismatch and penalty stress tensor of all grains
grainLoop: do iGrain = 1,product(prm%N_constituents)
Gmoduli = equivalentModuli(iGrain,ip,el)
muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain
bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector
muGrain = equivalentMu(iGrain,ip,el)
iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position
interfaceLoop: do iFace = 1,6
@ -700,9 +539,7 @@ module procedure mech_RGC_updateState
where(iGNghb3 < 1) iGNghb3 = nGDim
where(iGNghb3 >nGDim) iGNghb3 = 1
iGNghb = grain3to1(iGNghb3,prm%N_constituents) ! get the ID of the neighboring grain
Gmoduli = equivalentModuli(iGNghb,ip,el) ! collect the shear modulus and Burgers vector of the neighbor
muGNghb = Gmoduli(1)
bgGNghb = Gmoduli(2)
muGNghb = equivalentMu(iGNghb,ip,el)
gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor
!-------------------------------------------------------------------------------------------
@ -717,30 +554,19 @@ module procedure mech_RGC_updateState
enddo; enddo
nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity)
nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces)
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) then
print'(a,i2,a,i3)',' Mismatch to face: ',intFace(1),' neighbor grain: ',iGNghb
print*, transpose(nDef)
print'(a,e11.4)', ' with magnitude: ',nDefNorm
endif
#endif
!-------------------------------------------------------------------------------------------
! compute the stress penalty of all interfaces
do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3
rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xi_alpha &
rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*b + muGNghb*b)*prm%xi_alpha &
*surfCorr(abs(intFace(1)))/prm%D_alpha(abs(intFace(1))) &
*cosh(prm%c_alpha*nDefNorm) &
*0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) &
*tanh(nDefNorm/num%xSmoo)
enddo; enddo;enddo; enddo
enddo interfaceLoop
#ifdef DEBUG
if (debugHomog%extensive .and. prm%of_debug == of) then
print'(a,i2)', ' Penalty of grain: ',iGrain
print*, transpose(rPen(1:3,1:3,iGrain))
endif
#endif
enddo grainLoop
@ -783,13 +609,6 @@ module procedure mech_RGC_updateState
vPen(:,:,i) = -1.0_pReal/real(nGrain,pReal)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr* &
sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0),vDiscrep)* &
gVol(i)*transpose(math_inv33(fDef(:,:,i)))
#ifdef DEBUG
if (debugHomog%extensive .and. param(instance)%of_debug == of) then
print'(a,i2)',' Volume penalty of grain: ',i
print*, transpose(vPen(:,:,i))
endif
#endif
enddo
end subroutine volumePenalty
@ -827,44 +646,26 @@ module procedure mech_RGC_updateState
end function surfaceCorrection
!--------------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------------------
!> @brief compute the equivalent shear and bulk moduli from the elasticity tensor
!--------------------------------------------------------------------------------------------------
function equivalentModuli(grainID,ip,el)
real(pReal), dimension(2) :: equivalentModuli
!-------------------------------------------------------------------------------------------------
real(pReal) function equivalentMu(grainID,ip,el)
integer, intent(in) :: &
grainID,&
ip, & !< integration point number
el !< element number
real(pReal), dimension(6,6) :: elasTens
real(pReal) :: &
cEquiv_11, &
cEquiv_12, &
cEquiv_44
elasTens = constitutive_homogenizedC(grainID,ip,el)
!----------------------------------------------------------------------------------------------
! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005)
cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal
cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + &
elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal
cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal
equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44
!----------------------------------------------------------------------------------------------
! obtain the length of Burgers vector (could be model dependend)
equivalentModuli(2) = 2.5e-10_pReal
end function equivalentModuli
!--------------------------------------------------------------------------------------------------
equivalentMu = lattice_equivalent_mu(constitutive_homogenizedC(grainID,ip,el),'voigt')
end function equivalentMu
!-------------------------------------------------------------------------------------------------
!> @brief calculating the grain deformation gradient (the same with
! homogenization_RGC_partitionDeformation, but used only for perturbation scheme)
!--------------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------------------
subroutine grainDeformation(F, avgF, instance, of)
real(pReal), dimension(:,:,:), intent(out) :: F !< partitioned F per grain
@ -879,7 +680,7 @@ module procedure mech_RGC_updateState
integer, dimension(3) :: iGrain3
integer :: iGrain,iFace,i,j
!-------------------------------------------------------------------------------------------------
!-----------------------------------------------------------------------------------------------
! compute the deformation gradient of individual grains due to relaxations
associate(prm => param(instance))
@ -901,7 +702,7 @@ module procedure mech_RGC_updateState
end subroutine grainDeformation
end procedure mech_RGC_updateState
end function mech_RGC_updateState
!--------------------------------------------------------------------------------------------------
@ -935,15 +736,9 @@ module subroutine mech_RGC_results(instance,group)
associate(stt => state(instance), dst => dependentState(instance), prm => param(instance))
outputsLoop: do o = 1,size(prm%output)
select case(trim(prm%output(o)))
case('W')
call results_writeDataset(group,stt%work,trim(prm%output(o)), &
'work density','J/m³')
case('M')
call results_writeDataset(group,dst%mismatch,trim(prm%output(o)), &
'average mismatch tensor','1')
case('R')
call results_writeDataset(group,stt%penaltyEnergy,trim(prm%output(o)), &
'mismatch penalty density','J/m³')
case('Delta_V')
call results_writeDataset(group,dst%volumeDiscrepancy,trim(prm%output(o)), &
'volume discrepancy','m³')

2
src/homogenization_mech_isostrain.f90
View File

@ -4,7 +4,7 @@
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Isostrain (full constraint Taylor assuption) homogenization scheme
!--------------------------------------------------------------------------------------------------
submodule(homogenization) homogenization_mech_isostrain
submodule(homogenization:homogenization_mech) homogenization_mech_isostrain
enum, bind(c); enumerator :: &
parallel_ID, &

4
src/homogenization_mech_none.f90
View File

@ -4,7 +4,7 @@
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief dummy homogenization homogenization scheme for 1 constituent per material point
!--------------------------------------------------------------------------------------------------
submodule(homogenization) homogenization_mech_none
submodule(homogenization:homogenization_mech) homogenization_mech_none
contains
@ -28,7 +28,7 @@ module subroutine mech_none_init
if(homogenization_Nconstituents(h) /= 1) &
call IO_error(211,ext_msg='N_constituents (mech_none)')
Nmaterialpoints = count(material_homogenizationAt == h)
homogState(h)%sizeState = 0
allocate(homogState(h)%state0 (0,Nmaterialpoints))

39
src/homogenization_thermal.f90 Normal file
View File

@ -0,0 +1,39 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, KU Leuven
!--------------------------------------------------------------------------------------------------
submodule(homogenization) homogenization_thermal
contains
!--------------------------------------------------------------------------------------------------
!> @brief Allocate variables and set parameters.
!--------------------------------------------------------------------------------------------------
module subroutine thermal_init()
print'(/,a)', ' <<<+- homogenization_thermal init -+>>>'
allocate(homogenization_T(discretization_nIPs*discretization_Nelems))
end subroutine thermal_init
!--------------------------------------------------------------------------------------------------
!> @brief Partition T onto the individual constituents.
!--------------------------------------------------------------------------------------------------
module subroutine thermal_partition(T,ip,el)
real(pReal), intent(in) :: T
integer, intent(in) :: &
ip, & !< integration point
el !< element number
call constitutive_thermal_setT(T,1,ip,el)
end subroutine thermal_partition
end submodule homogenization_thermal

8
src/kinematics_cleavage_opening.f90
View File

@ -99,10 +99,10 @@ end function kinematics_cleavage_opening_init
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el)
integer, intent(in) :: &
ipc, & !< grain number
co, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(in), dimension(3,3) :: &
@ -120,11 +120,11 @@ module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S,
udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
damageOffset = material_homogenizationMemberAt(ip,el)
Ld = 0.0_pReal
dLd_dTstar = 0.0_pReal
associate(prm => param(kinematics_cleavage_opening_instance(material_phaseAt(ipc,el))))
associate(prm => param(kinematics_cleavage_opening_instance(material_phaseAt(co,el))))
do i = 1,prm%sum_N_cl
traction_crit = prm%g_crit(i)* damage(homog)%p(damageOffset)**2.0_pReal

8
src/kinematics_slipplane_opening.f90
View File

@ -117,10 +117,10 @@ end function kinematics_slipplane_opening_init
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el)
integer, intent(in) :: &
ipc, & !< grain number
co, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(in), dimension(3,3) :: &
@ -138,10 +138,10 @@ module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S
traction_d, traction_t, traction_n, traction_crit, &
udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
phase = material_phaseAt(ipc,el)
phase = material_phaseAt(co,el)
instance = kinematics_slipplane_opening_instance(phase)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
damageOffset = material_homogenizationMemberAt(ip,el)
associate(prm => param(instance))
Ld = 0.0_pReal

43
src/kinematics_thermal_expansion.f90
View File

@ -26,7 +26,7 @@ contains
!--------------------------------------------------------------------------------------------------
module function kinematics_thermal_expansion_init(kinematics_length) result(myKinematics)
integer, intent(in) :: kinematics_length
integer, intent(in) :: kinematics_length
logical, dimension(:,:), allocatable :: myKinematics
integer :: Ninstances,p,i,k
@ -35,8 +35,8 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi
phases, &
phase, &
kinematics, &
kinematic_type
kinematic_type
print'(/,a)', ' <<<+- kinematics_thermal_expansion init -+>>>'
myKinematics = kinematics_active('thermal_expansion',kinematics_length)
@ -50,13 +50,13 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi
do p = 1, phases%length
if(any(myKinematics(:,p))) kinematics_thermal_expansion_instance(p) = count(myKinematics(:,1:p))
phase => phases%get(p)
phase => phases%get(p)
if(count(myKinematics(:,p)) == 0) cycle
kinematics => phase%get('kinematics')
do k = 1, kinematics%length
if(myKinematics(k,p)) then
associate(prm => param(kinematics_thermal_expansion_instance(p)))
kinematic_type => kinematics%get(k)
kinematic_type => kinematics%get(k)
prm%T_ref = kinematic_type%get_asFloat('T_ref', defaultVal=0.0_pReal)
@ -81,36 +81,13 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi
end function kinematics_thermal_expansion_init
!--------------------------------------------------------------------------------------------------
!> @brief report initial thermal strain based on current temperature deviation from reference
!--------------------------------------------------------------------------------------------------
pure module function kinematics_thermal_expansion_initialStrain(homog,phase,offset) result(initialStrain)
integer, intent(in) :: &
phase, &
homog, &
offset
real(pReal), dimension(3,3) :: &
initialStrain !< initial thermal strain (should be small strain, though)
associate(prm => param(kinematics_thermal_expansion_instance(phase)))
initialStrain = &
(temperature(homog)%p(offset) - prm%T_ref)**1 / 1. * prm%A(1:3,1:3,1) + & ! constant coefficient
(temperature(homog)%p(offset) - prm%T_ref)**2 / 2. * prm%A(1:3,1:3,2) + & ! linear coefficient
(temperature(homog)%p(offset) - prm%T_ref)**3 / 3. * prm%A(1:3,1:3,3) ! quadratic coefficient
end associate
end function kinematics_thermal_expansion_initialStrain
!--------------------------------------------------------------------------------------------------
!> @brief constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el)
module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, co, ip, el)
integer, intent(in) :: &
ipc, & !< grain number
co, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(out), dimension(3,3) :: &
@ -124,10 +101,10 @@ module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, i
real(pReal) :: &
T, TDot
phase = material_phaseAt(ipc,el)
phase = material_phaseAt(co,el)
homog = material_homogenizationAt(el)
T = temperature(homog)%p(thermalMapping(homog)%p(ip,el))
TDot = temperatureRate(homog)%p(thermalMapping(homog)%p(ip,el))
T = temperature(homog)%p(material_homogenizationMemberAt(ip,el))
TDot = temperatureRate(homog)%p(material_homogenizationMemberAt(ip,el))
associate(prm => param(kinematics_thermal_expansion_instance(phase)))
Li = TDot * ( &

113
src/lattice.f90
View File

@ -421,6 +421,8 @@ module lattice
lattice_BCT_ID, &
lattice_HEX_ID, &
lattice_ORT_ID, &
lattice_equivalent_nu, &
lattice_equivalent_mu, &
lattice_applyLatticeSymmetry33, &
lattice_SchmidMatrix_slip, &
lattice_SchmidMatrix_twin, &
@ -451,12 +453,13 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine lattice_init
integer :: Nphases, p,i
integer :: Nphases, ph,i
class(tNode), pointer :: &
phases, &
phase, &
mech, &
elasticity
elasticity, &
thermal
print'(/,a)', ' <<<+- lattice init -+>>>'; flush(IO_STDOUT)
@ -474,67 +477,71 @@ subroutine lattice_init
lattice_mu, lattice_nu,&
source=[(0.0_pReal,i=1,Nphases)])
do p = 1, phases%length
phase => phases%get(p)
do ph = 1, phases%length
phase => phases%get(ph)
mech => phase%get('mechanics')
elasticity => mech%get('elasticity')
lattice_C66(1,1,p) = elasticity%get_asFloat('C_11')
lattice_C66(1,2,p) = elasticity%get_asFloat('C_12')
lattice_C66(1,1,ph) = elasticity%get_asFloat('C_11')
lattice_C66(1,2,ph) = elasticity%get_asFloat('C_12')
lattice_C66(1,3,p) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal)
lattice_C66(2,2,p) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal)
lattice_C66(2,3,p) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal)
lattice_C66(3,3,p) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal)
lattice_C66(4,4,p) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal)
lattice_C66(5,5,p) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal)
lattice_C66(6,6,p) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal)
lattice_C66(1,3,ph) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal)
lattice_C66(2,2,ph) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal)
lattice_C66(2,3,ph) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal)
lattice_C66(3,3,ph) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal)
lattice_C66(4,4,ph) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal)
lattice_C66(5,5,ph) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal)
lattice_C66(6,6,ph) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal)
select case(phase%get_asString('lattice'))
case('cF')
lattice_structure(p) = lattice_FCC_ID
lattice_structure(ph) = lattice_FCC_ID
case('cI')
lattice_structure(p) = lattice_BCC_ID
lattice_structure(ph) = lattice_BCC_ID
case('hP')
lattice_structure(p) = lattice_HEX_ID
lattice_structure(ph) = lattice_HEX_ID
case('tI')
lattice_structure(p) = lattice_BCT_ID
lattice_structure(ph) = lattice_BCT_ID
case('oP')
lattice_structure(p) = lattice_ORT_ID
lattice_structure(ph) = lattice_ORT_ID
case('aP')
lattice_structure(p) = lattice_ISO_ID
lattice_structure(ph) = lattice_ISO_ID
case default
call IO_error(130,ext_msg='lattice_init: '//phase%get_asString('lattice'))
end select
lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice'))
lattice_C66(1:6,1:6,ph) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,ph),phase%get_asString('lattice'))
lattice_mu(p) = equivalent_mu(lattice_C66(1:6,1:6,p),'voigt')
lattice_nu(p) = equivalent_nu(lattice_C66(1:6,1:6,p),'voigt')
lattice_nu(ph) = lattice_equivalent_nu(lattice_C66(1:6,1:6,ph),'voigt')
lattice_mu(ph) = lattice_equivalent_mu(lattice_C66(1:6,1:6,ph),'voigt')
lattice_C66(1:6,1:6,p) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,p))) ! Literature data is in Voigt notation
lattice_C66(1:6,1:6,ph) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,ph))) ! Literature data is in Voigt notation
do i = 1, 6
if (abs(lattice_C66(i,i,p))<tol_math_check) &
call IO_error(135,el=i,ip=p,ext_msg='matrix diagonal "el"ement of phase "ip"')
if (abs(lattice_C66(i,i,ph))<tol_math_check) &
call IO_error(135,el=i,ip=ph,ext_msg='matrix diagonal "el"ement of phase "ip"')
enddo
lattice_rho(ph) = phase%get_asFloat('rho', defaultVal=0.0_pReal)
! SHOULD NOT BE PART OF LATTICE BEGIN
lattice_K(1,1,p) = phase%get_asFloat('K_11',defaultVal=0.0_pReal)
lattice_K(2,2,p) = phase%get_asFloat('K_22',defaultVal=0.0_pReal)
lattice_K(3,3,p) = phase%get_asFloat('K_33',defaultVal=0.0_pReal)
lattice_K(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_K(1:3,1:3,p), &
if (phase%contains('thermal')) then
thermal => phase%get('thermal')
lattice_K(1,1,ph) = thermal%get_asFloat('K_11',defaultVal=0.0_pReal)
lattice_K(2,2,ph) = thermal%get_asFloat('K_22',defaultVal=0.0_pReal)
lattice_K(3,3,ph) = thermal%get_asFloat('K_33',defaultVal=0.0_pReal)
lattice_K(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_K(1:3,1:3,ph), &
phase%get_asString('lattice'))
lattice_c_p(ph) = thermal%get_asFloat('c_p', defaultVal=0.0_pReal)
endif
lattice_D(1,1,ph) = phase%get_asFloat('D_11',defaultVal=0.0_pReal)
lattice_D(2,2,ph) = phase%get_asFloat('D_22',defaultVal=0.0_pReal)
lattice_D(3,3,ph) = phase%get_asFloat('D_33',defaultVal=0.0_pReal)
lattice_D(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,ph), &
phase%get_asString('lattice'))
lattice_c_p(p) = phase%get_asFloat('c_p', defaultVal=0.0_pReal)
lattice_rho(p) = phase%get_asFloat('rho', defaultVal=0.0_pReal)
lattice_D(1,1,p) = phase%get_asFloat('D_11',defaultVal=0.0_pReal)
lattice_D(2,2,p) = phase%get_asFloat('D_22',defaultVal=0.0_pReal)
lattice_D(3,3,p) = phase%get_asFloat('D_33',defaultVal=0.0_pReal)
lattice_D(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,p), &
phase%get_asString('lattice'))
lattice_M(p) = phase%get_asFloat('M',defaultVal=0.0_pReal)
lattice_M(ph) = phase%get_asFloat('M',defaultVal=0.0_pReal)
! SHOULD NOT BE PART OF LATTICE END
call selfTest
@ -2188,15 +2195,16 @@ end function getlabels
!> @brief Equivalent Poisson's ratio (ν)
!> @details https://doi.org/10.1143/JPSJ.20.635
!--------------------------------------------------------------------------------------------------
function equivalent_nu(C,assumption) result(nu)
function lattice_equivalent_nu(C,assumption) result(nu)
real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)
real(pReal) :: K, mu, nu
logical :: error
real(pReal), dimension(6,6) :: S
if (IO_lc(assumption) == 'voigt') then
K = (C(1,1)+C(2,2)+C(3,3) +2.0_pReal*(C(1,2)+C(2,3)+C(1,3))) &
/ 9.0_pReal
@ -2210,25 +2218,26 @@ function equivalent_nu(C,assumption) result(nu)
K = 0.0_pReal
endif
mu = equivalent_mu(C,assumption)
mu = lattice_equivalent_mu(C,assumption)
nu = (1.5_pReal*K -mu)/(3.0_pReal*K+mu)
end function equivalent_nu
end function lattice_equivalent_nu
!--------------------------------------------------------------------------------------------------
!> @brief Equivalent shear modulus (μ)
!> @details https://doi.org/10.1143/JPSJ.20.635
!--------------------------------------------------------------------------------------------------
function equivalent_mu(C,assumption) result(mu)
function lattice_equivalent_mu(C,assumption) result(mu)
real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)
real(pReal) :: mu
logical :: error
real(pReal), dimension(6,6) :: S
if (IO_lc(assumption) == 'voigt') then
mu = (1.0_pReal*(C(1,1)+C(2,2)+C(3,3)) -1.0_pReal*(C(1,2)+C(2,3)+C(1,3)) +3.0_pReal*(C(4,4)+C(5,5)+C(6,6))) &
/ 15.0_pReal
@ -2242,7 +2251,7 @@ function equivalent_mu(C,assumption) result(mu)
mu = 0.0_pReal
endif
end function equivalent_mu
end function lattice_equivalent_mu
!--------------------------------------------------------------------------------------------------
@ -2266,14 +2275,14 @@ subroutine selfTest
call random_number(C)
C(1,1) = C(1,1) + 1.0_pReal
C = applyLatticeSymmetryC66(C,'aP')
if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt'
if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss'
if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt'
if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss'
lambda = C(1,2)
if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'voigt')),equivalent_nu(C,'voigt'),1.0e-12_pReal)) &
error stop 'equivalent_nu/voigt'
if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'reuss')),equivalent_nu(C,'reuss'),1.0e-12_pReal)) &
error stop 'equivalent_nu/reuss'
if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'voigt')), &
lattice_equivalent_nu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_nu/voigt'
if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'reuss')), &
lattice_equivalent_nu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_nu/reuss'
end subroutine selfTest

4
src/marc/discretization_marc.f90
View File

@ -12,7 +12,6 @@ module discretization_marc
use DAMASK_interface
use IO
use config
use FEsolving
use element
use discretization
use geometry_plastic_nonlocal
@ -89,9 +88,6 @@ subroutine discretization_marc_init
if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,ext_msg='element')
if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP')
FEsolving_execElem = [1,nElems]
FEsolving_execIP = [1,elem%nIPs]
allocate(cellNodeDefinition(elem%nNodes-1))
allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems))
call buildCells(connectivity_cell,cellNodeDefinition,&

100
src/material.f90
View File

@ -17,34 +17,9 @@ module material
private
enum, bind(c); enumerator :: &
ELASTICITY_UNDEFINED_ID, &
ELASTICITY_HOOKE_ID, &
PLASTICITY_UNDEFINED_ID, &
PLASTICITY_NONE_ID, &
PLASTICITY_ISOTROPIC_ID, &
PLASTICITY_PHENOPOWERLAW_ID, &
PLASTICITY_KINEHARDENING_ID, &
PLASTICITY_DISLOTWIN_ID, &
PLASTICITY_DISLOTUNGSTEN_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, &
KINEMATICS_UNDEFINED_ID ,&
KINEMATICS_CLEAVAGE_OPENING_ID, &
KINEMATICS_SLIPPLANE_OPENING_ID, &
KINEMATICS_THERMAL_EXPANSION_ID, &
STIFFNESS_DEGRADATION_UNDEFINED_ID, &
STIFFNESS_DEGRADATION_DAMAGE_ID, &
THERMAL_ISOTHERMAL_ID, &
THERMAL_ADIABATIC_ID, &
THERMAL_CONDUCTION_ID, &
DAMAGE_NONE_ID, &
DAMAGE_LOCAL_ID, &
DAMAGE_NONLOCAL_ID, &
HOMOGENIZATION_UNDEFINED_ID, &
HOMOGENIZATION_NONE_ID, &
@ -64,21 +39,20 @@ module material
homogenization_type !< type of each homogenization
integer, public, protected :: &
homogenization_maxNconstituents !< max number of grains in any USED homogenization
homogenization_maxNconstituents !< max number of grains in any USED homogenization
integer, dimension(:), allocatable, public, protected :: &
homogenization_Nconstituents, & !< number of grains in each homogenization
homogenization_Nconstituents, & !< number of grains in each homogenization
homogenization_typeInstance, & !< instance of particular type of each homogenization
thermal_typeInstance, & !< instance of particular type of each thermal transport
damage_typeInstance !< instance of particular type of each nonlocal damage
real(pReal), dimension(:), allocatable, public, protected :: &
thermal_initialT, & !< initial temperature per each homogenization
damage_initialPhi !< initial damage per each homogenization
thermal_initialT !< initial temperature per each homogenization
integer, dimension(:), allocatable, public, protected :: & ! (elem)
material_homogenizationAt !< homogenization ID of each element
integer, dimension(:,:), allocatable, public, target :: & ! (ip,elem) ToDo: ugly target for mapping hack
integer, dimension(:,:), allocatable, public, protected :: & ! (ip,elem)
material_homogenizationMemberAt !< position of the element within its homogenization instance
integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem)
material_phaseAt !< phase ID of each element
@ -87,20 +61,11 @@ module material
type(tState), allocatable, dimension(:), public :: &
homogState, &
thermalState, &
damageState
damageState_h
type(Rotation), dimension(:,:,:), allocatable, public, protected :: &
material_orientation0 !< initial orientation of each grain,IP,element
! BEGIN DEPRECATED
integer, dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field
! END DEPRECATED
type(tHomogMapping), allocatable, dimension(:), public :: &
thermalMapping, & !< mapping for thermal state/fields
damageMapping !< mapping for damage state/fields
type(group_float), allocatable, dimension(:), public :: &
temperature, & !< temperature field
damage, & !< damage field
@ -108,34 +73,9 @@ module material
public :: &
material_init, &
ELASTICITY_UNDEFINED_ID, &
ELASTICITY_HOOKE_ID, &
PLASTICITY_UNDEFINED_ID, &
PLASTICITY_NONE_ID, &
PLASTICITY_ISOTROPIC_ID, &
PLASTICITY_PHENOPOWERLAW_ID, &
PLASTICITY_KINEHARDENING_ID, &
PLASTICITY_DISLOTWIN_ID, &
PLASTICITY_DISLOTUNGSTEN_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, &
KINEMATICS_UNDEFINED_ID ,&
KINEMATICS_CLEAVAGE_OPENING_ID, &
KINEMATICS_SLIPPLANE_OPENING_ID, &
KINEMATICS_THERMAL_EXPANSION_ID, &
STIFFNESS_DEGRADATION_UNDEFINED_ID, &
STIFFNESS_DEGRADATION_DAMAGE_ID, &
THERMAL_ISOTHERMAL_ID, &
THERMAL_ADIABATIC_ID, &
THERMAL_CONDUCTION_ID, &
DAMAGE_NONE_ID, &
DAMAGE_LOCAL_ID, &
DAMAGE_NONLOCAL_ID, &
HOMOGENIZATION_NONE_ID, &
HOMOGENIZATION_ISOSTRAIN_ID, &
@ -149,7 +89,6 @@ contains
subroutine material_init(restart)
logical, intent(in) :: restart
integer :: myHomog
print'(/,a)', ' <<<+- material init -+>>>'; flush(IO_STDOUT)
@ -162,39 +101,20 @@ subroutine material_init(restart)
allocate(homogState (size(material_name_homogenization)))
allocate(thermalState (size(material_name_homogenization)))
allocate(damageState (size(material_name_homogenization)))
allocate(thermalMapping (size(material_name_homogenization)))
allocate(damageMapping (size(material_name_homogenization)))
allocate(damageState_h (size(material_name_homogenization)))
allocate(temperature (size(material_name_homogenization)))
allocate(damage (size(material_name_homogenization)))
allocate(temperatureRate (size(material_name_homogenization)))
if (.not. restart) then
call results_openJobFile
call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,material_name_phase)
call results_mapping_phase(material_phaseAt,material_phaseMemberAt,material_name_phase)
call results_mapping_homogenization(material_homogenizationAt,material_homogenizationMemberAt,material_name_homogenization)
call results_closeJobFile
endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN DEPRECATED
allocate(mappingHomogenizationConst( discretization_nIPs,discretization_Nelems),source=1)
! hack needed to initialize field values used during constitutive initialization
do myHomog = 1, size(material_name_homogenization)
thermalMapping (myHomog)%p => mappingHomogenizationConst
damageMapping (myHomog)%p => mappingHomogenizationConst
allocate(temperature (myHomog)%p(1), source=thermal_initialT(myHomog))
allocate(damage (myHomog)%p(1), source=damage_initialPhi(myHomog))
allocate(temperatureRate (myHomog)%p(1), source=0.0_pReal)
enddo
! END DEPRECATED
end subroutine material_init
@ -222,7 +142,6 @@ subroutine material_parseHomogenization
allocate(thermal_typeInstance(size(material_name_homogenization)), source=0)
allocate(damage_typeInstance(size(material_name_homogenization)), source=0)
allocate(thermal_initialT(size(material_name_homogenization)), source=300.0_pReal)
allocate(damage_initialPhi(size(material_name_homogenization)), source=1.0_pReal)
do h=1, size(material_name_homogenization)
homog => material_homogenization%get(h)
@ -247,8 +166,6 @@ subroutine material_parseHomogenization
select case (homogThermal%get_asString('type'))
case('isothermal')
thermal_type(h) = THERMAL_isothermal_ID
case('adiabatic')
thermal_type(h) = THERMAL_adiabatic_ID
case('conduction')
thermal_type(h) = THERMAL_conduction_ID
case default
@ -258,12 +175,9 @@ subroutine material_parseHomogenization
if(homog%contains('damage')) then
homogDamage => homog%get('damage')
damage_initialPhi(h) = homogDamage%get_asFloat('phi_0',defaultVal=1.0_pReal)
select case (homogDamage%get_asString('type'))
case('none')
damage_type(h) = DAMAGE_none_ID
case('local')
damage_type(h) = DAMAGE_local_ID
case('nonlocal')
damage_type(h) = DAMAGE_nonlocal_ID
case default

7
src/math.f90
View File

@ -279,9 +279,12 @@ real(pReal) pure function math_LeviCivita(i,j,k)
integer, intent(in) :: i,j,k
if (all([i,j,k] == [1,2,3]) .or. all([i,j,k] == [2,3,1]) .or. all([i,j,k] == [3,1,2])) then
integer :: o
if (any([(all(cshift([i,j,k],o) == [1,2,3]),o=0,2)])) then
math_LeviCivita = +1.0_pReal
elseif (all([i,j,k] == [3,2,1]) .or. all([i,j,k] == [2,1,3]) .or. all([i,j,k] == [1,3,2])) then
elseif (any([(all(cshift([i,j,k],o) == [3,2,1]),o=0,2)])) then
math_LeviCivita = -1.0_pReal
else
math_LeviCivita = 0.0_pReal

1
src/mesh/DAMASK_mesh.f90
View File

@ -15,7 +15,6 @@ program DAMASK_mesh
use IO
use math
use CPFEM2
use FEsolving
use config
use discretization_mesh
use FEM_Utilities

4
src/mesh/FEM_utilities.f90
View File

@ -160,11 +160,11 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
print'(/,a)', ' ... evaluating constitutive response ......................................'
call materialpoint_stressAndItsTangent(timeinc) ! calculate P field
call materialpoint_stressAndItsTangent(timeinc,[1,mesh_maxNips],[1,mesh_NcpElems]) ! calculate P field
cutBack = .false. ! reset cutBack status
P_av = sum(sum(homogenization_P,dim=4),dim=3) * wgt ! average of P
P_av = sum(homogenization_P,dim=3) * wgt
call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
end subroutine utilities_constitutiveResponse

50
src/mesh/discretization_mesh.f90
View File

@ -18,7 +18,6 @@ module discretization_mesh
use config
use discretization
use results
use FEsolving
use FEM_quadrature
use YAML_types
use prec
@ -30,7 +29,7 @@ module discretization_mesh
mesh_Nboundaries, &
mesh_NcpElemsGlobal
integer :: &
integer, public, protected :: &
mesh_NcpElems !< total number of CP elements in mesh
!!!! BEGIN DEPRECATED !!!!!
@ -84,6 +83,7 @@ subroutine discretization_mesh_init(restart)
num_mesh
integer :: integrationOrder !< order of quadrature rule required
print'(/,a)', ' <<<+- discretization_mesh init -+>>>'
!--------------------------------------------------------------------------------
@ -96,13 +96,15 @@ subroutine discretization_mesh_init(restart)
debug_element = config_debug%get_asInt('element',defaultVal=1)
debug_ip = config_debug%get_asInt('integrationpoint',defaultVal=1)
call DMPlexCreateFromFile(PETSC_COMM_WORLD,interface_geomFile,PETSC_TRUE,globalMesh,ierr)
CHKERRQ(ierr)
call DMGetDimension(globalMesh,dimPlex,ierr)
CHKERRQ(ierr)
call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr)
CHKERRQ(ierr)
call DMView(globalMesh, PETSC_VIEWER_STDOUT_WORLD,ierr)
CHKERRQ(ierr)
! get number of IDs in face sets (for boundary conditions?)
call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr)
CHKERRQ(ierr)
@ -110,6 +112,13 @@ subroutine discretization_mesh_init(restart)
call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
if (worldrank == 0) then
call DMClone(globalMesh,geomMesh,ierr)
else
call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr)
endif
CHKERRQ(ierr)
allocate(mesh_boundaries(mesh_Nboundaries), source = 0)
call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr)
CHKERRQ(ierr)
@ -124,35 +133,6 @@ subroutine discretization_mesh_init(restart)
endif
call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
if (worldrank == 0) then
fileContent = IO_readlines(interface_geomFile)
l = 0
do
l = l + 1
if (IO_isBlank(fileContent(l))) cycle ! need also to ignore C and C++ style comments?
if (trim(fileContent(l)) == '$Elements') then
j = 0
l = l + 1
do
l = l + 1
if (trim(fileContent(l)) == '$EndElements') exit
chunkPos = IO_stringPos(fileContent(l))
if (chunkPos(1) == 3+IO_intValue(fileContent(l),chunkPos,3)+dimPlex+1) then
call DMSetLabelValue(globalMesh,'material',j,IO_intValue(fileContent(l),chunkPos,4),ierr)
CHKERRQ(ierr)
j = j + 1
endif
enddo
exit
endif
enddo
call DMClone(globalMesh,geomMesh,ierr)
CHKERRQ(ierr)
else
call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr)
CHKERRQ(ierr)
endif
call DMDestroy(globalMesh,ierr); CHKERRQ(ierr)
call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_NcpElems,ierr)
@ -167,16 +147,14 @@ subroutine discretization_mesh_init(restart)
allocate(materialAt(mesh_NcpElems))
do j = 1, mesh_NcpElems
call DMGetLabelValue(geomMesh,'material',j-1,materialAt(j),ierr)
call DMGetLabelValue(geomMesh,'Cell Sets',j-1,materialAt(j),ierr)
CHKERRQ(ierr)
end do
materialAt = materialAt + 1
if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element')
if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP')
FEsolving_execElem = [1,mesh_NcpElems] ! parallel loop bounds set to comprise all DAMASK elements
FEsolving_execIP = [1,mesh_maxNips]
allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
call discretization_init(materialAt,&

78
src/mesh/mesh_mech_FEM.f90
View File

@ -32,7 +32,6 @@ module mesh_mech_FEM
type tSolutionParams
type(tFieldBC) :: fieldBC
real(pReal) :: timeinc
real(pReal) :: timeincOld
end type tSolutionParams
type(tSolutionParams) :: params
@ -147,14 +146,9 @@ subroutine FEM_mech_init(fieldBC)
call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr)
call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr)
nBasis = nBasis/nc
#if (PETSC_VERSION_MINOR > 10)
call DMAddField(mech_mesh,PETSC_NULL_DMLABEL,mechFE,ierr); CHKERRQ(ierr)
call DMCreateDS(mech_mesh,ierr); CHKERRQ(ierr)
#endif
call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr)
#if (PETSC_VERSION_MINOR < 11)
call PetscDSAddDiscretization(mechDS,mechFE,ierr); CHKERRQ(ierr)
#endif
call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr)
call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr)
call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr)
@ -163,11 +157,7 @@ subroutine FEM_mech_init(fieldBC)
! Setup FEM mech boundary conditions
call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr)
call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr)
#if (PETSC_VERSION_MINOR < 12)
call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr)
#else
call DMGetLocalSection(mech_mesh,section,ierr); CHKERRQ(ierr)
#endif
allocate(pnumComp(1), source=dimPlex)
allocate(pnumDof(0:dimPlex), source = 0)
do topologDim = 0, dimPlex
@ -205,14 +195,8 @@ subroutine FEM_mech_init(fieldBC)
endif
endif
enddo; enddo
#if (PETSC_VERSION_MINOR < 11)
call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, &
numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr)
#else
call DMPlexCreateSection(mech_mesh,nolabel,pNumComp,pNumDof, &
numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr)
#endif
CHKERRQ(ierr)
call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr)
do faceSet = 1, numBC
@ -267,11 +251,7 @@ subroutine FEM_mech_init(fieldBC)
x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pReal)
enddo
px_scal => x_scal
#if (PETSC_VERSION_MINOR < 11)
call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,INSERT_ALL_VALUES,ierr)
#else
call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr) ! PETSc: cbee0a90b60958e5c50c89b1e41f4451dfa6008c
#endif
call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr)
CHKERRQ(ierr)
enddo
@ -302,7 +282,6 @@ type(tSolutionState) function FEM_mech_solution( &
!--------------------------------------------------------------------------------------------------
! set module wide availabe data
params%timeinc = timeinc
params%timeincOld = timeinc_old
params%fieldBC = fieldBC
call SNESSolve(mech_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution)
@ -337,16 +316,16 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
Vec :: x_local, f_local, xx_local
PetscSection :: section
PetscScalar, dimension(:), pointer :: x_scal, pf_scal
PetscScalar, target :: f_scal(cellDof)
PetscReal :: detJ, IcellJMat(dimPlex,dimPlex)
PetscReal, pointer,dimension(:) :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer
PetscScalar, dimension(cellDof), target :: f_scal
PetscReal :: IcellJMat(dimPlex,dimPlex)
PetscReal, dimension(:),pointer :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer
PetscInt :: cellStart, cellEnd, cell, field, face, &
qPt, basis, comp, cidx, &
numFields
PetscReal :: detFAvg
PetscReal :: BMat(dimPlex*dimPlex,cellDof)
numFields, &
bcSize,m
PetscReal :: detFAvg, detJ
PetscReal, dimension(dimPlex*dimPlex,cellDof) :: BMat
PetscInt :: bcSize
IS :: bcPoints
@ -355,11 +334,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
allocate(pinvcellJ(dimPlex**2))
allocate(x_scal(cellDof))
#if (PETSC_VERSION_MINOR < 12)
call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr)
#else
call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr)
#endif
call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr)
call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr)
CHKERRQ(ierr)
@ -391,6 +366,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
CHKERRQ(ierr)
IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
do qPt = 0, nQuadrature-1
m = cell*nQuadrature + qPt+1
BMat = 0.0
do basis = 0, nBasis-1
do comp = 0, dimPlex-1
@ -400,15 +376,14 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
(((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex))
enddo
enddo
homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1) = &
reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
homogenization_F(1:dimPlex,1:dimPlex,m) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
enddo
if (num%BBarStabilisation) then
detFAvg = math_det33(sum(homogenization_F(1:3,1:3,1:nQuadrature,cell+1),dim=3)/real(nQuadrature))
do qPt = 1, nQuadrature
homogenization_F(1:dimPlex,1:dimPlex,qPt,cell+1) = &
homogenization_F(1:dimPlex,1:dimPlex,qPt,cell+1)* &
(detFAvg/math_det33(homogenization_F(1:3,1:3,qPt,cell+1)))**(1.0/real(dimPlex))
detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature))
do qPt = 0, nQuadrature-1
m = cell*nQuadrature + qPt+1
homogenization_F(1:dimPlex,1:dimPlex,m) = homogenization_F(1:dimPlex,1:dimPlex,m) &
* (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0/real(dimPlex))
enddo
endif
@ -432,6 +407,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
f_scal = 0.0
do qPt = 0, nQuadrature-1
m = cell*nQuadrature + qPt+1
BMat = 0.0
do basis = 0, nBasis-1
do comp = 0, dimPlex-1
@ -443,7 +419,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
enddo
f_scal = f_scal + &
matmul(transpose(BMat), &
reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,qPt+1,cell+1)), &
reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,m)), &
shape=[dimPlex*dimPlex]))*qWeights(qPt+1)
enddo
f_scal = f_scal*abs(detJ)
@ -488,7 +464,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
K_eB
PetscInt :: cellStart, cellEnd, cell, field, face, &
qPt, basis, comp, cidx,bcSize
qPt, basis, comp, cidx,bcSize, m
IS :: bcPoints
@ -502,11 +478,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
call MatZeroEntries(Jac,ierr); CHKERRQ(ierr)
call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr)
call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr)
#if (PETSC_VERSION_MINOR < 12)
call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr)
#else
call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr)
#endif
call DMGetGlobalSection(dm_local,gSection,ierr); CHKERRQ(ierr)
call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
@ -535,6 +507,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
FAvg = 0.0
BMatAvg = 0.0
do qPt = 0, nQuadrature-1
m = cell*nQuadrature + qPt + 1
BMat = 0.0
do basis = 0, nBasis-1
do comp = 0, dimPlex-1
@ -545,7 +518,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
(((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex))
enddo
enddo
MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,qPt+1,cell+1), &
MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,m), &
shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), &
shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1)
if (num%BBarStabilisation) then
@ -553,12 +526,11 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
FInv = math_inv33(F)
K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0/real(dimPlex))
K_eB = K_eB - &
matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1), &
shape=[dimPlex*dimPlex,1]), &
matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[dimPlex*dimPlex,1]), &
matmul(reshape(FInv(1:dimPlex,1:dimPlex), &
shape=[1,dimPlex*dimPlex],order=[2,1]),BMat))),MatA)
MatB = MatB + &
matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1),shape=[1,dimPlex*dimPlex]),MatA)
MatB = MatB &
+ matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[1,dimPlex*dimPlex]),MatA)
FAvg = FAvg + F
BMatAvg = BMatAvg + BMat
else
@ -686,8 +658,8 @@ subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dumm
print'(/,1x,a,a,i0,a,i0,f0.3)', trim(incInfo), &
' @ Iteration ',PETScIter,' mechanical residual norm = ', &
int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol)
write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',&
transpose(P_av)*1.e-6_pReal
print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
' Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal
flush(IO_STDOUT)
end subroutine FEM_mech_converged

38
src/prec.f90
View File

@ -54,7 +54,7 @@ module prec
type, extends(tState) :: tPlasticState
logical :: &
nonlocal = .false.
real(pReal), pointer, dimension(:,:) :: &
real(pReal), pointer, dimension(:,:) :: &
slipRate !< slip rate
end type
@ -62,10 +62,6 @@ module prec
type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase
end type
type :: tHomogMapping
integer, pointer, dimension(:,:) :: p
end type
real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0.
real(pReal), private, parameter :: PREAL_MIN = tiny(0.0_pReal) !< smallest normalized floating point number
@ -112,8 +108,10 @@ logical elemental pure function dEq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -136,11 +134,8 @@ logical elemental pure function dNeq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
if (present(tol)) then
dNeq = .not. dEq(a,b,tol)
else
dNeq = .not. dEq(a,b)
endif
dNeq = .not. dEq(a,b,tol)
end function dNeq
@ -155,8 +150,10 @@ logical elemental pure function dEq0(a,tol)
real(pReal), intent(in) :: a
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -179,11 +176,8 @@ logical elemental pure function dNeq0(a,tol)
real(pReal), intent(in) :: a
real(pReal), intent(in), optional :: tol
if (present(tol)) then
dNeq0 = .not. dEq0(a,tol)
else
dNeq0 = .not. dEq0(a)
endif
dNeq0 = .not. dEq0(a,tol)
end function dNeq0
@ -199,8 +193,10 @@ logical elemental pure function cEq(a,b,tol)
complex(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
else
@ -224,11 +220,8 @@ logical elemental pure function cNeq(a,b,tol)
complex(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
if (present(tol)) then
cNeq = .not. cEq(a,b,tol)
else
cNeq = .not. cEq(a,b)
endif
cNeq = .not. cEq(a,b,tol)
end function cNeq
@ -242,6 +235,7 @@ pure function prec_bytesToC_FLOAT(bytes)
real(C_FLOAT), dimension(size(bytes,kind=pI64)/(storage_size(0._C_FLOAT,pI64)/8_pI64)) :: &
prec_bytesToC_FLOAT
prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT))
end function prec_bytesToC_FLOAT
@ -256,6 +250,7 @@ pure function prec_bytesToC_DOUBLE(bytes)
real(C_DOUBLE), dimension(size(bytes,kind=pI64)/(storage_size(0._C_DOUBLE,pI64)/8_pI64)) :: &
prec_bytesToC_DOUBLE
prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE))
end function prec_bytesToC_DOUBLE
@ -270,6 +265,7 @@ pure function prec_bytesToC_INT32_T(bytes)
integer(C_INT32_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT32_T,pI64)/8_pI64)) :: &
prec_bytesToC_INT32_T
prec_bytesToC_INT32_T = transfer(bytes,prec_bytesToC_INT32_T,size(prec_bytesToC_INT32_T))
end function prec_bytesToC_INT32_T
@ -284,6 +280,7 @@ pure function prec_bytesToC_INT64_T(bytes)
integer(C_INT64_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT64_T,pI64)/8_pI64)) :: &
prec_bytesToC_INT64_T
prec_bytesToC_INT64_T = transfer(bytes,prec_bytesToC_INT64_T,size(prec_bytesToC_INT64_T))
end function prec_bytesToC_INT64_T
@ -299,6 +296,7 @@ subroutine selfTest
integer(pInt), dimension(1) :: i
real(pReal), dimension(2) :: r
realloc_lhs_test = [1,2]
if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation'

534
src/quaternions.f90
View File

@ -1,534 +0,0 @@
!---------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Michigan State University
!> @brief general quaternion math, not limited to unit quaternions
!> @details w is the real part, (x, y, z) are the imaginary parts.
!> @details https://en.wikipedia.org/wiki/Quaternion
!---------------------------------------------------------------------------------------------------
module quaternions
use prec
implicit none
private
real(pReal), parameter, public :: P = -1.0_pReal !< parameter for orientation conversion.
type, public :: quaternion
real(pReal), private :: w = 0.0_pReal
real(pReal), private :: x = 0.0_pReal
real(pReal), private :: y = 0.0_pReal
real(pReal), private :: z = 0.0_pReal
contains
procedure, private :: add__
procedure, private :: pos__
generic, public :: operator(+) => add__,pos__
procedure, private :: sub__
procedure, private :: neg__
generic, public :: operator(-) => sub__,neg__
procedure, private :: mul_quat__
procedure, private :: mul_scal__
generic, public :: operator(*) => mul_quat__, mul_scal__
procedure, private :: div_quat__
procedure, private :: div_scal__
generic, public :: operator(/) => div_quat__, div_scal__
procedure, private :: eq__
generic, public :: operator(==) => eq__
procedure, private :: neq__
generic, public :: operator(/=) => neq__
procedure, private :: pow_quat__
procedure, private :: pow_scal__
generic, public :: operator(**) => pow_quat__, pow_scal__
procedure, public :: abs => abs__
procedure, public :: conjg => conjg__
procedure, public :: real => real__
procedure, public :: aimag => aimag__
procedure, public :: homomorphed
procedure, public :: asArray
procedure, public :: inverse
end type
interface assignment (=)
module procedure assign_quat__
module procedure assign_vec__
end interface assignment (=)
interface quaternion
module procedure init__
end interface quaternion
interface abs
procedure abs__
end interface abs
interface dot_product
procedure dot_product__
end interface dot_product
interface conjg
module procedure conjg__
end interface conjg
interface exp
module procedure exp__
end interface exp
interface log
module procedure log__
end interface log
interface real
module procedure real__
end interface real
interface aimag
module procedure aimag__
end interface aimag
public :: &
quaternions_init, &
assignment(=), &
conjg, aimag, &
log, exp, &
abs, dot_product, &
inverse, &
real
contains
!--------------------------------------------------------------------------------------------------
!> @brief Do self test.
!--------------------------------------------------------------------------------------------------
subroutine quaternions_init
print'(/,a)', ' <<<+- quaternions init -+>>>'; flush(6)
call selfTest
end subroutine quaternions_init
!---------------------------------------------------------------------------------------------------
!> @brief construct a quaternion from a 4-vector
!---------------------------------------------------------------------------------------------------
type(quaternion) pure function init__(array)
real(pReal), intent(in), dimension(4) :: array
init__%w = array(1)
init__%x = array(2)
init__%y = array(3)
init__%z = array(4)
end function init__
!---------------------------------------------------------------------------------------------------
!> @brief assign a quaternion
!---------------------------------------------------------------------------------------------------
elemental pure subroutine assign_quat__(self,other)
type(quaternion), intent(out) :: self
type(quaternion), intent(in) :: other
self = [other%w,other%x,other%y,other%z]
end subroutine assign_quat__
!---------------------------------------------------------------------------------------------------
!> @brief assign a 4-vector
!---------------------------------------------------------------------------------------------------
pure subroutine assign_vec__(self,other)
type(quaternion), intent(out) :: self
real(pReal), intent(in), dimension(4) :: other
self%w = other(1)
self%x = other(2)
self%y = other(3)
self%z = other(4)
end subroutine assign_vec__
!---------------------------------------------------------------------------------------------------
!> @brief add a quaternion
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function add__(self,other)
class(quaternion), intent(in) :: self,other
add__ = [ self%w, self%x, self%y ,self%z] &
+ [other%w, other%x, other%y,other%z]
end function add__
!---------------------------------------------------------------------------------------------------
!> @brief return (unary positive operator)
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function pos__(self)
class(quaternion), intent(in) :: self
pos__ = self * (+1.0_pReal)
end function pos__
!---------------------------------------------------------------------------------------------------
!> @brief subtract a quaternion
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function sub__(self,other)
class(quaternion), intent(in) :: self,other
sub__ = [ self%w, self%x, self%y ,self%z] &
- [other%w, other%x, other%y,other%z]
end function sub__
!---------------------------------------------------------------------------------------------------
!> @brief negate (unary negative operator)
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function neg__(self)
class(quaternion), intent(in) :: self
neg__ = self * (-1.0_pReal)
end function neg__
!---------------------------------------------------------------------------------------------------
!> @brief multiply with a quaternion
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function mul_quat__(self,other)
class(quaternion), intent(in) :: self, other
mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z
mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y)
mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z)
mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x)
end function mul_quat__
!---------------------------------------------------------------------------------------------------
!> @brief multiply with a scalar
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function mul_scal__(self,scal)
class(quaternion), intent(in) :: self
real(pReal), intent(in) :: scal
mul_scal__ = [self%w,self%x,self%y,self%z]*scal
end function mul_scal__
!---------------------------------------------------------------------------------------------------
!> @brief divide by a quaternion
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function div_quat__(self,other)
class(quaternion), intent(in) :: self, other
div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal))
end function div_quat__
!---------------------------------------------------------------------------------------------------
!> @brief divide by a scalar
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function div_scal__(self,scal)
class(quaternion), intent(in) :: self
real(pReal), intent(in) :: scal
div_scal__ = [self%w,self%x,self%y,self%z]/scal
end function div_scal__
!---------------------------------------------------------------------------------------------------
!> @brief test equality
!---------------------------------------------------------------------------------------------------
logical elemental pure function eq__(self,other)
class(quaternion), intent(in) :: self,other
eq__ = all(dEq([ self%w, self%x, self%y, self%z], &
[other%w,other%x,other%y,other%z]))
end function eq__
!---------------------------------------------------------------------------------------------------
!> @brief test inequality
!---------------------------------------------------------------------------------------------------
logical elemental pure function neq__(self,other)
class(quaternion), intent(in) :: self,other
neq__ = .not. self%eq__(other)
end function neq__
!---------------------------------------------------------------------------------------------------
!> @brief raise to the power of a quaternion
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function pow_quat__(self,expon)
class(quaternion), intent(in) :: self
type(quaternion), intent(in) :: expon
pow_quat__ = exp(log(self)*expon)
end function pow_quat__
!---------------------------------------------------------------------------------------------------
!> @brief raise to the power of a scalar
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function pow_scal__(self,expon)
class(quaternion), intent(in) :: self
real(pReal), intent(in) :: expon
pow_scal__ = exp(log(self)*expon)
end function pow_scal__
!---------------------------------------------------------------------------------------------------
!> @brief take exponential
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function exp__(a)
class(quaternion), intent(in) :: a
real(pReal) :: absImag
absImag = norm2(aimag(a))
exp__ = merge(exp(a%w) * [ cos(absImag), &
a%x/absImag * sin(absImag), &
a%y/absImag * sin(absImag), &
a%z/absImag * sin(absImag)], &
IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), &
dNeq0(absImag))
end function exp__
!---------------------------------------------------------------------------------------------------
!> @brief take logarithm
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function log__(a)
class(quaternion), intent(in) :: a
real(pReal) :: absImag
absImag = norm2(aimag(a))
log__ = merge([log(abs(a)), &
a%x/absImag * acos(a%w/abs(a)), &
a%y/absImag * acos(a%w/abs(a)), &
a%z/absImag * acos(a%w/abs(a))], &
IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), &
dNeq0(absImag))
end function log__
!---------------------------------------------------------------------------------------------------
!> @brief return norm
!---------------------------------------------------------------------------------------------------
real(pReal) elemental pure function abs__(self)
class(quaternion), intent(in) :: self
abs__ = norm2([self%w,self%x,self%y,self%z])
end function abs__
!---------------------------------------------------------------------------------------------------
!> @brief calculate dot product
!---------------------------------------------------------------------------------------------------
real(pReal) elemental pure function dot_product__(a,b)
class(quaternion), intent(in) :: a,b
dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z
end function dot_product__
!---------------------------------------------------------------------------------------------------
!> @brief take conjugate complex
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function conjg__(self)
class(quaternion), intent(in) :: self
conjg__ = [self%w,-self%x,-self%y,-self%z]
end function conjg__
!---------------------------------------------------------------------------------------------------
!> @brief homomorph
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function homomorphed(self)
class(quaternion), intent(in) :: self
homomorphed = - self
end function homomorphed
!---------------------------------------------------------------------------------------------------
!> @brief return as plain array
!---------------------------------------------------------------------------------------------------
pure function asArray(self)
real(pReal), dimension(4) :: asArray
class(quaternion), intent(in) :: self
asArray = [self%w,self%x,self%y,self%z]
end function asArray
!---------------------------------------------------------------------------------------------------
!> @brief real part (scalar)
!---------------------------------------------------------------------------------------------------
pure function real__(self)
real(pReal) :: real__
class(quaternion), intent(in) :: self
real__ = self%w
end function real__
!---------------------------------------------------------------------------------------------------
!> @brief imaginary part (3-vector)
!---------------------------------------------------------------------------------------------------
pure function aimag__(self)
real(pReal), dimension(3) :: aimag__
class(quaternion), intent(in) :: self
aimag__ = [self%x,self%y,self%z]
end function aimag__
!---------------------------------------------------------------------------------------------------
!> @brief inverse
!---------------------------------------------------------------------------------------------------
type(quaternion) elemental pure function inverse(self)
class(quaternion), intent(in) :: self
inverse = conjg(self)/abs(self)**2.0_pReal
end function inverse
!--------------------------------------------------------------------------------------------------
!> @brief check correctness of some quaternions functions
!--------------------------------------------------------------------------------------------------
subroutine selfTest
real(pReal), dimension(4) :: qu
type(quaternion) :: q, q_2
if(dNeq(abs(P),1.0_pReal)) error stop 'P not in {-1,+1}'
call random_number(qu)
qu = (qu-0.5_pReal) * 2.0_pReal
q = quaternion(qu)
q_2= qu
if(any(dNeq(q%asArray(),q_2%asArray()))) error stop 'assign_vec__'
q_2 = q + q
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) error stop 'add__'
q_2 = q - q
if(any(dNeq0(q_2%asArray()))) error stop 'sub__'
q_2 = q * 5.0_pReal
if(any(dNeq(q_2%asArray(),5.0_pReal*qu))) error stop 'mul__'
q_2 = q / 0.5_pReal
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) error stop 'div__'
q_2 = q * 0.3_pReal
if(dNeq0(abs(q)) .and. q_2 == q) error stop 'eq__'
q_2 = q
if(q_2 /= q) error stop 'neq__'
if(dNeq(abs(q),norm2(qu))) error stop 'abs__'
if(dNeq(abs(q)**2.0_pReal, real(q*q%conjg()),1.0e-14_pReal)) &
error stop 'abs__/*conjg'
if(any(dNeq(q%asArray(),qu))) error stop 'eq__'
if(dNeq(q%real(), qu(1))) error stop 'real()'
if(any(dNeq(q%aimag(), qu(2:4)))) error stop 'aimag()'
q_2 = q%homomorphed()
if(q /= q_2* (-1.0_pReal)) error stop 'homomorphed'
if(dNeq(q_2%real(), qu(1)* (-1.0_pReal))) error stop 'homomorphed/real'
if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) error stop 'homomorphed/aimag'
q_2 = conjg(q)
if(dNeq(abs(q),abs(q_2))) error stop 'conjg/abs'
if(q /= conjg(q_2)) error stop 'conjg/involution'
if(dNeq(q_2%real(), q%real())) error stop 'conjg/real'
if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) error stop 'conjg/aimag'
if(abs(q) > 0.0_pReal) then
q_2 = q * q%inverse()
if( dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal)) error stop 'inverse/real'
if(any(dNeq0(aimag(q_2), 1.0e-15_pReal))) error stop 'inverse/aimag'
q_2 = q/abs(q)
q_2 = conjg(q_2) - inverse(q_2)
if(any(dNeq0(q_2%asArray(),1.0e-15_pReal))) error stop 'inverse/conjg'
endif
if(dNeq(dot_product(qu,qu),dot_product(q,q))) error stop 'dot_product'
#if !(defined(__GFORTRAN__) && __GNUC__ < 9)
if (norm2(aimag(q)) > 0.0_pReal) then
if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal)) error stop 'exp/log'
if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal)) error stop 'log/exp'
endif
#endif
end subroutine selfTest
end module quaternions

171
src/results.f90
View File

@ -49,7 +49,7 @@ module results
results_setLink, &
results_addAttribute, &
results_removeLink, &
results_mapping_constituent, &
results_mapping_phase, &
results_mapping_homogenization
contains
@ -111,8 +111,6 @@ subroutine results_addIncrement(inc,time)
call results_closeGroup(results_addGroup(trim('inc'//trim(adjustl(incChar)))))
call results_setLink(trim('inc'//trim(adjustl(incChar))),'current')
call results_addAttribute('time/s',time,trim('inc'//trim(adjustl(incChar))))
call results_closeGroup(results_addGroup('current/phase'))
call results_closeGroup(results_addGroup('current/homogenization'))
end subroutine results_addIncrement
@ -461,7 +459,7 @@ end subroutine results_writeTensorDataset_int
!--------------------------------------------------------------------------------------------------
!> @brief adds the unique mapping from spatial position and constituent ID to results
!--------------------------------------------------------------------------------------------------
subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
subroutine results_mapping_phase(phaseAt,memberAtLocal,label)
integer, dimension(:,:), intent(in) :: phaseAt !< phase section at (constituent,element)
integer, dimension(:,:,:), intent(in) :: memberAtLocal !< phase member at (constituent,IP,element)
@ -491,6 +489,47 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
integer(SIZE_T) :: type_size_string, type_size_int
integer :: hdferr, ierr, i
!--------------------------------------------------------------------------------------------------
! prepare MPI communication (transparent for non-MPI runs)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
memberOffset = 0
do i=1, size(label)
memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process
enddo
writeSize = 0
writeSize(worldrank) = size(memberAtLocal(1,:,:)) ! total number of points by this process
!--------------------------------------------------------------------------------------------------
! MPI settings and communication
#ifdef PETSc
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process
if(ierr /= 0) error stop 'MPI error'
call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
if(ierr /= 0) error stop 'MPI error'
#endif
myShape = int([size(phaseAt,1),writeSize(worldrank)], HSIZE_T)
myOffset = int([0,sum(writeSize(0:worldrank-1))], HSIZE_T)
totalShape = int([size(phaseAt,1),sum(writeSize)], HSIZE_T)
!---------------------------------------------------------------------------------------------------
! expand phaseAt to consider IPs (is not stored per IP)
do i = 1, size(phaseAtMaterialpoint,2)
phaseAtMaterialpoint(:,i,:) = phaseAt
enddo
!---------------------------------------------------------------------------------------------------
! renumber member from my process to all processes
do i = 1, size(label)
where(phaseAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) -1 ! convert to 0-based
enddo
!---------------------------------------------------------------------------------------------------
! compound type: name of phase section + position/index within results array
call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr)
@ -525,34 +564,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
call h5tclose_f(dt_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!--------------------------------------------------------------------------------------------------
! prepare MPI communication (transparent for non-MPI runs)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
memberOffset = 0
do i=1, size(label)
memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process
enddo
writeSize = 0
writeSize(worldrank) = size(memberAtLocal(1,:,:)) ! total number of points by this process
!--------------------------------------------------------------------------------------------------
! MPI settings and communication
#ifdef PETSc
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process
if(ierr /= 0) error stop 'MPI error'
call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
if(ierr /= 0) error stop 'MPI error'
#endif
myShape = int([size(phaseAt,1),writeSize(worldrank)], HSIZE_T)
myOffset = int([0,sum(writeSize(0:worldrank-1))], HSIZE_T)
totalShape = int([size(phaseAt,1),sum(writeSize)], HSIZE_T)
!--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape = hyperslab) and in file (global shape)
call h5screate_simple_f(2,myShape,memspace_id,hdferr,myShape)
@ -564,18 +575,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!---------------------------------------------------------------------------------------------------
! expand phaseAt to consider IPs (is not stored per IP)
do i = 1, size(phaseAtMaterialpoint,2)
phaseAtMaterialpoint(:,i,:) = phaseAt
enddo
!---------------------------------------------------------------------------------------------------
! renumber member from my process to all processes
do i = 1, size(label)
where(phaseAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) -1 ! convert to 0-based
enddo
!--------------------------------------------------------------------------------------------------
! write the components of the compound type individually
call h5pset_preserve_f(plist_id, .TRUE., hdferr)
@ -609,7 +608,7 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(position_id, hdferr)
end subroutine results_mapping_constituent
end subroutine results_mapping_phase
!--------------------------------------------------------------------------------------------------
@ -645,6 +644,48 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label)
integer(SIZE_T) :: type_size_string, type_size_int
integer :: hdferr, ierr, i
!--------------------------------------------------------------------------------------------------
! prepare MPI communication (transparent for non-MPI runs)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
memberOffset = 0
do i=1, size(label)
memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process
enddo
writeSize = 0
writeSize(worldrank) = size(memberAtLocal) ! total number of points by this process
!--------------------------------------------------------------------------------------------------
! MPI settings and communication
#ifdef PETSc
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process
if(ierr /= 0) error stop 'MPI error'
call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
if(ierr /= 0) error stop 'MPI error'
#endif
myShape = int([writeSize(worldrank)], HSIZE_T)
myOffset = int([sum(writeSize(0:worldrank-1))], HSIZE_T)
totalShape = int([sum(writeSize)], HSIZE_T)
!---------------------------------------------------------------------------------------------------
! expand phaseAt to consider IPs (is not stored per IP)
do i = 1, size(homogenizationAtMaterialpoint,1)
homogenizationAtMaterialpoint(i,:) = homogenizationAt
enddo
!---------------------------------------------------------------------------------------------------
! renumber member from my process to all processes
do i = 1, size(label)
where(homogenizationAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) - 1 ! convert to 0-based
enddo
!---------------------------------------------------------------------------------------------------
! compound type: name of phase section + position/index within results array
call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr)
@ -679,34 +720,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label)
call h5tclose_f(dt_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!--------------------------------------------------------------------------------------------------
! prepare MPI communication (transparent for non-MPI runs)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
memberOffset = 0
do i=1, size(label)
memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process
enddo
writeSize = 0
writeSize(worldrank) = size(memberAtLocal) ! total number of points by this process
!--------------------------------------------------------------------------------------------------
! MPI settings and communication
#ifdef PETSc
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process
if(ierr /= 0) error stop 'MPI error'
call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
if(ierr /= 0) error stop 'MPI error'
#endif
myShape = int([writeSize(worldrank)], HSIZE_T)
myOffset = int([sum(writeSize(0:worldrank-1))], HSIZE_T)
totalShape = int([sum(writeSize)], HSIZE_T)
!--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape = hyperslab) and in file (global shape)
call h5screate_simple_f(1,myShape,memspace_id,hdferr,myShape)
@ -718,18 +731,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label)
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!---------------------------------------------------------------------------------------------------
! expand phaseAt to consider IPs (is not stored per IP)
do i = 1, size(homogenizationAtMaterialpoint,1)
homogenizationAtMaterialpoint(i,:) = homogenizationAt
enddo
!---------------------------------------------------------------------------------------------------
! renumber member from my process to all processes
do i = 1, size(label)
where(homogenizationAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) - 1 ! convert to 0-based
enddo
!--------------------------------------------------------------------------------------------------
! write the components of the compound type individually
call h5pset_preserve_f(plist_id, .TRUE., hdferr)

83
src/rotations.f90
View File

@ -47,16 +47,16 @@
!---------------------------------------------------------------------------------------------------
module rotations
use prec
use IO
use math
use quaternions
implicit none
private
real(pReal), parameter :: P = -1.0_pReal !< parameter for orientation conversion.
type, public :: rotation
type(quaternion) :: q
real(pReal), dimension(4) :: q
contains
procedure, public :: asQuaternion
procedure, public :: asEulers
@ -103,7 +103,6 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine rotations_init
call quaternions_init
print'(/,a)', ' <<<+- rotations init -+>>>'; flush(IO_STDOUT)
print*, 'Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015'
@ -122,7 +121,7 @@ pure function asQuaternion(self)
class(rotation), intent(in) :: self
real(pReal), dimension(4) :: asQuaternion
asQuaternion = self%q%asArray()
asQuaternion = self%q
end function asQuaternion
!---------------------------------------------------------------------------------------------------
@ -131,7 +130,7 @@ pure function asEulers(self)
class(rotation), intent(in) :: self
real(pReal), dimension(3) :: asEulers
asEulers = qu2eu(self%q%asArray())
asEulers = qu2eu(self%q)
end function asEulers
!---------------------------------------------------------------------------------------------------
@ -140,7 +139,7 @@ pure function asAxisAngle(self)
class(rotation), intent(in) :: self
real(pReal), dimension(4) :: asAxisAngle
asAxisAngle = qu2ax(self%q%asArray())
asAxisAngle = qu2ax(self%q)
end function asAxisAngle
!---------------------------------------------------------------------------------------------------
@ -149,7 +148,7 @@ pure function asMatrix(self)
class(rotation), intent(in) :: self
real(pReal), dimension(3,3) :: asMatrix
asMatrix = qu2om(self%q%asArray())
asMatrix = qu2om(self%q)
end function asMatrix
!---------------------------------------------------------------------------------------------------
@ -158,7 +157,7 @@ pure function asRodrigues(self)
class(rotation), intent(in) :: self
real(pReal), dimension(4) :: asRodrigues
asRodrigues = qu2ro(self%q%asArray())
asRodrigues = qu2ro(self%q)
end function asRodrigues
!---------------------------------------------------------------------------------------------------
@ -167,7 +166,7 @@ pure function asHomochoric(self)
class(rotation), intent(in) :: self
real(pReal), dimension(3) :: asHomochoric
asHomochoric = qu2ho(self%q%asArray())
asHomochoric = qu2ho(self%q)
end function asHomochoric
@ -259,7 +258,7 @@ pure elemental function rotRot__(self,R) result(rRot)
type(rotation) :: rRot
class(rotation), intent(in) :: self,R
rRot = rotation(self%q*R%q)
rRot = rotation(multiply_quaternion(self%q,R%q))
call rRot%standardize()
end function rotRot__
@ -272,14 +271,14 @@ pure elemental subroutine standardize(self)
class(rotation), intent(inout) :: self
if (real(self%q) < 0.0_pReal) self%q = self%q%homomorphed()
if (self%q(1) < 0.0_pReal) self%q = - self%q
end subroutine standardize
!---------------------------------------------------------------------------------------------------
!> @author Marc De Graef, Carnegie Mellon University
!> @brief rotate a vector passively (default) or actively
!> @brief Rotate a vector passively (default) or actively.
!---------------------------------------------------------------------------------------------------
pure function rotVector(self,v,active) result(vRot)
@ -288,9 +287,8 @@ pure function rotVector(self,v,active) result(vRot)
real(pReal), intent(in), dimension(3) :: v
logical, intent(in), optional :: active
real(pReal), dimension(3) :: v_normed
type(quaternion) :: q
logical :: passive
real(pReal), dimension(4) :: v_normed, q
logical :: passive
if (present(active)) then
passive = .not. active
@ -301,13 +299,13 @@ pure function rotVector(self,v,active) result(vRot)
if (dEq0(norm2(v))) then
vRot = v
else
v_normed = v/norm2(v)
v_normed = [0.0_pReal,v]/norm2(v)
if (passive) then
q = self%q * (quaternion([0.0_pReal, v_normed(1), v_normed(2), v_normed(3)]) * conjg(self%q) )
q = multiply_quaternion(self%q, multiply_quaternion(v_normed, conjugate_quaternion(self%q)))
else
q = conjg(self%q) * (quaternion([0.0_pReal, v_normed(1), v_normed(2), v_normed(3)]) * self%q )
q = multiply_quaternion(conjugate_quaternion(self%q), multiply_quaternion(v_normed, self%q))
endif
vRot = q%aimag()*norm2(v)
vRot = q(2:4)*norm2(v)
endif
end function rotVector
@ -315,8 +313,8 @@ end function rotVector
!---------------------------------------------------------------------------------------------------
!> @author Marc De Graef, Carnegie Mellon University
!> @brief rotate a rank-2 tensor passively (default) or actively
!> @details: rotation is based on rotation matrix
!> @brief Rotate a rank-2 tensor passively (default) or actively.
!> @details: Rotation is based on rotation matrix
!---------------------------------------------------------------------------------------------------
pure function rotTensor2(self,T,active) result(tRot)
@ -403,7 +401,7 @@ pure elemental function misorientation(self,other)
type(rotation) :: misorientation
class(rotation), intent(in) :: self, other
misorientation%q = other%q * conjg(self%q)
misorientation%q = multiply_quaternion(other%q, conjugate_quaternion(self%q))
end function misorientation
@ -1338,7 +1336,7 @@ end function cu2ho
!--------------------------------------------------------------------------
!> @author Marc De Graef, Carnegie Mellon University
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief determine to which pyramid a point in a cubic grid belongs
!> @brief Determine to which pyramid a point in a cubic grid belongs.
!--------------------------------------------------------------------------
pure function GetPyramidOrder(xyz)
@ -1362,7 +1360,39 @@ end function GetPyramidOrder
!--------------------------------------------------------------------------------------------------
!> @brief check correctness of some rotations functions
!> @brief Multiply two quaternions.
!--------------------------------------------------------------------------------------------------
pure function multiply_quaternion(qu1,qu2)
real(pReal), dimension(4), intent(in) :: qu1, qu2
real(pReal), dimension(4) :: multiply_quaternion
multiply_quaternion(1) = qu1(1)*qu2(1) - qu1(2)*qu2(2) - qu1(3)*qu2(3) - qu1(4)*qu2(4)
multiply_quaternion(2) = qu1(1)*qu2(2) + qu1(2)*qu2(1) + P * (qu1(3)*qu2(4) - qu1(4)*qu2(3))
multiply_quaternion(3) = qu1(1)*qu2(3) + qu1(3)*qu2(1) + P * (qu1(4)*qu2(2) - qu1(2)*qu2(4))
multiply_quaternion(4) = qu1(1)*qu2(4) + qu1(4)*qu2(1) + P * (qu1(2)*qu2(3) - qu1(3)*qu2(2))
end function multiply_quaternion
!--------------------------------------------------------------------------------------------------
!> @brief Calculate conjugate complex of a quaternion.
!--------------------------------------------------------------------------------------------------
pure function conjugate_quaternion(qu)
real(pReal), dimension(4), intent(in) :: qu
real(pReal), dimension(4) :: conjugate_quaternion
conjugate_quaternion = [qu(1), -qu(2), -qu(3), -qu(4)]
end function conjugate_quaternion
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some rotations functions.
!--------------------------------------------------------------------------------------------------
subroutine selfTest
@ -1374,7 +1404,8 @@ subroutine selfTest
real :: A,B
integer :: i
do i=1,10
do i = 1, 10
#if defined(__GFORTRAN__) && __GNUC__<9
if(i<7) cycle

26
src/source_damage_anisoBrittle.f90
View File

@ -101,9 +101,9 @@ module function source_damage_anisoBrittle_init(source_length) result(mySources)
if (any(prm%s_crit < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit'
Nconstituents = count(material_phaseAt==p) * discretization_nIPs
call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal)
if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol'
call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0)
damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal)
if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol'
end associate
@ -120,10 +120,10 @@ end function source_damage_anisoBrittle_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el)
integer, intent(in) :: &
ipc, & !< component-ID of integration point
co, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), intent(in), dimension(3,3) :: &
@ -139,14 +139,14 @@ module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
real(pReal) :: &
traction_d, traction_t, traction_n, traction_crit
phase = material_phaseAt(ipc,el)
constituent = material_phasememberAt(ipc,ip,el)
phase = material_phaseAt(co,el)
constituent = material_phasememberAt(co,ip,el)
sourceOffset = source_damage_anisoBrittle_offset(phase)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
damageOffset = material_homogenizationMemberAt(ip,el)
associate(prm => param(source_damage_anisoBrittle_instance(phase)))
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
damageState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
do i = 1, prm%sum_N_cl
traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i))
traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i))
@ -154,8 +154,8 @@ module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
traction_crit = prm%g_crit(i)*damage(homog)%p(damageOffset)**2.0_pReal
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) &
= sourceState(phase)%p(sourceOffset)%dotState(1,constituent) &
damageState(phase)%p(sourceOffset)%dotState(1,constituent) &
= damageState(phase)%p(sourceOffset)%dotState(1,constituent) &
+ prm%dot_o / prm%s_crit(i) &
* ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + &
(max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + &
@ -185,7 +185,7 @@ module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, d
sourceOffset = source_damage_anisoBrittle_offset(phase)
dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent)
localphiDot = 1.0_pReal &
+ dLocalphiDot_dPhi*phi
@ -204,7 +204,7 @@ module subroutine source_damage_anisoBrittle_results(phase,group)
integer :: o
associate(prm => param(source_damage_anisoBrittle_instance(phase)), &
stt => sourceState(phase)%p(source_damage_anisoBrittle_offset(phase))%state)
stt => damageState(phase)%p(source_damage_anisoBrittle_offset(phase))%state)
outputsLoop: do o = 1,size(prm%output)
select case(trim(prm%output(o)))
case ('f_phi')

22
src/source_damage_anisoDuctile.f90
View File

@ -87,9 +87,9 @@ module function source_damage_anisoDuctile_init(source_length) result(mySources)
if (any(prm%gamma_crit < 0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit'
Nconstituents=count(material_phaseAt==p) * discretization_nIPs
call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal)
if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol'
call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0)
damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal)
if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol'
end associate
@ -107,10 +107,10 @@ end function source_damage_anisoDuctile_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
module subroutine source_damage_anisoDuctile_dotState(co, ip, el)
integer, intent(in) :: &
ipc, & !< component-ID of integration point
co, & !< component-ID of integration point
ip, & !< integration point
el !< element
@ -121,14 +121,14 @@ module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
damageOffset, &
homog
phase = material_phaseAt(ipc,el)
constituent = material_phasememberAt(ipc,ip,el)
phase = material_phaseAt(co,el)
constituent = material_phasememberAt(co,ip,el)
sourceOffset = source_damage_anisoDuctile_offset(phase)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
damageOffset = material_homogenizationMemberAt(ip,el)
associate(prm => param(source_damage_anisoDuctile_instance(phase)))
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) &
damageState(phase)%p(sourceOffset)%dotState(1,constituent) &
= sum(plasticState(phase)%slipRate(:,constituent)/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit)
end associate
@ -154,7 +154,7 @@ module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, d
sourceOffset = source_damage_anisoDuctile_offset(phase)
dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent)
localphiDot = 1.0_pReal &
+ dLocalphiDot_dPhi*phi
@ -173,7 +173,7 @@ module subroutine source_damage_anisoDuctile_results(phase,group)
integer :: o
associate(prm => param(source_damage_anisoDuctile_instance(phase)), &
stt => sourceState(phase)%p(source_damage_anisoDuctile_offset(phase))%state)
stt => damageState(phase)%p(source_damage_anisoDuctile_offset(phase))%state)
outputsLoop: do o = 1,size(prm%output)
select case(trim(prm%output(o)))
case ('f_phi')

32
src/source_damage_isoBrittle.f90
View File

@ -74,9 +74,9 @@ module function source_damage_isoBrittle_init(source_length) result(mySources)
if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit'
Nconstituents = count(material_phaseAt==p) * discretization_nIPs
call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,1)
sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal)
if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol'
call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,1)
damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal)
if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol'
end associate
@ -94,10 +94,10 @@ end function source_damage_isoBrittle_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el)
integer, intent(in) :: &
ipc, & !< component-ID of integration point
co, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), intent(in), dimension(3,3) :: &
@ -114,8 +114,8 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
real(pReal) :: &
strainenergy
phase = material_phaseAt(ipc,el) !< phase ID at ipc,ip,el
constituent = material_phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el
phase = material_phaseAt(co,el) !< phase ID at co,ip,el
constituent = material_phasememberAt(co,ip,el) !< state array offset for phase ID at co,ip,el
sourceOffset = source_damage_isoBrittle_offset(phase)
strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3)
@ -124,13 +124,13 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit
! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit
if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent)
if (strainenergy > damageState(phase)%p(sourceOffset)%subState0(1,constituent)) then
damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
strainenergy - damageState(phase)%p(sourceOffset)%state(1,constituent)
else
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - &
sourceState(phase)%p(sourceOffset)%state(1,constituent)
damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
damageState(phase)%p(sourceOffset)%subState0(1,constituent) - &
damageState(phase)%p(sourceOffset)%state(1,constituent)
endif
end associate
@ -158,8 +158,8 @@ module subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLo
associate(prm => param(source_damage_isoBrittle_instance(phase)))
localphiDot = 1.0_pReal &
- phi*sourceState(phase)%p(sourceOffset)%state(1,constituent)
dLocalphiDot_dPhi = - sourceState(phase)%p(sourceOffset)%state(1,constituent)
- phi*damageState(phase)%p(sourceOffset)%state(1,constituent)
dLocalphiDot_dPhi = - damageState(phase)%p(sourceOffset)%state(1,constituent)
end associate
end subroutine source_damage_isoBrittle_getRateAndItsTangent
@ -176,7 +176,7 @@ module subroutine source_damage_isoBrittle_results(phase,group)
integer :: o
associate(prm => param(source_damage_isoBrittle_instance(phase)), &
stt => sourceState(phase)%p(source_damage_isoBrittle_offset(phase))%state)
stt => damageState(phase)%p(source_damage_isoBrittle_offset(phase))%state)
outputsLoop: do o = 1,size(prm%output)
select case(trim(prm%output(o)))
case ('f_phi')

22
src/source_damage_isoDuctile.f90
View File

@ -78,9 +78,9 @@ module function source_damage_isoDuctile_init(source_length) result(mySources)
if (prm%gamma_crit <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit'
Nconstituents=count(material_phaseAt==p) * discretization_nIPs
call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal)
if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol'
call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0)
damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal)
if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol'
end associate
@ -98,10 +98,10 @@ end function source_damage_isoDuctile_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
module subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
module subroutine source_damage_isoDuctile_dotState(co, ip, el)
integer, intent(in) :: &
ipc, & !< component-ID of integration point
co, & !< component-ID of integration point
ip, & !< integration point
el !< element
@ -112,14 +112,14 @@ module subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
damageOffset, &
homog
phase = material_phaseAt(ipc,el)
constituent = material_phasememberAt(ipc,ip,el)
phase = material_phaseAt(co,el)
constituent = material_phasememberAt(co,ip,el)
sourceOffset = source_damage_isoDuctile_offset(phase)
homog = material_homogenizationAt(el)
damageOffset = damageMapping(homog)%p(ip,el)
damageOffset = material_homogenizationMemberAt(ip,el)
associate(prm => param(source_damage_isoDuctile_instance(phase)))
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
damageState(phase)%p(sourceOffset)%dotState(1,constituent) = &
sum(plasticState(phase)%slipRate(:,constituent))/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit
end associate
@ -145,7 +145,7 @@ module subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLo
sourceOffset = source_damage_isoDuctile_offset(phase)
dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent)
localphiDot = 1.0_pReal &
+ dLocalphiDot_dPhi*phi
@ -164,7 +164,7 @@ module subroutine source_damage_isoDuctile_results(phase,group)
integer :: o
associate(prm => param(source_damage_isoDuctile_instance(phase)), &
stt => sourceState(phase)%p(source_damage_isoDuctile_offset(phase))%state)
stt => damageState(phase)%p(source_damage_isoDuctile_offset(phase))%state)
outputsLoop: do o = 1,size(prm%output)
select case(trim(prm%output(o)))
case ('f_phi')

229
src/thermal_adiabatic.f90
View File

@ -1,229 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for adiabatic temperature evolution
!--------------------------------------------------------------------------------------------------
module thermal_adiabatic
use prec
use config
use material
use results
use constitutive
use YAML_types
use crystallite
use lattice
implicit none
private
type :: tParameters
character(len=pStringLen), allocatable, dimension(:) :: &
output
end type tParameters
type(tparameters), dimension(:), allocatable :: &
param
public :: &
thermal_adiabatic_init, &
thermal_adiabatic_updateState, &
thermal_adiabatic_getSourceAndItsTangent, &
thermal_adiabatic_getSpecificHeat, &
thermal_adiabatic_getMassDensity, &
thermal_adiabatic_results
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine thermal_adiabatic_init
integer :: maxNinstances,h,Nmaterialpoints
class(tNode), pointer :: &
material_homogenization, &
homog, &
homogThermal
print'(/,a)', ' <<<+- thermal_adiabatic init -+>>>'; flush(6)
maxNinstances = count(thermal_type == THERMAL_adiabatic_ID)
if (maxNinstances == 0) return
allocate(param(maxNinstances))
material_homogenization => config_material%get('homogenization')
do h = 1, size(material_name_homogenization)
if (thermal_type(h) /= THERMAL_adiabatic_ID) cycle
homog => material_homogenization%get(h)
homogThermal => homog%get('thermal')
associate(prm => param(thermal_typeInstance(h)))
#if defined (__GFORTRAN__)
prm%output = output_asStrings(homogThermal)
#else
prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray)
#endif
Nmaterialpoints=count(material_homogenizationAt==h)
thermalState(h)%sizeState = 1
allocate(thermalState(h)%state0 (1,Nmaterialpoints), source=thermal_initialT(h))
allocate(thermalState(h)%subState0(1,Nmaterialpoints), source=thermal_initialT(h))
allocate(thermalState(h)%state (1,Nmaterialpoints), source=thermal_initialT(h))
thermalMapping(h)%p => material_homogenizationMemberAt
deallocate(temperature(h)%p)
temperature(h)%p => thermalState(h)%state(1,:)
deallocate(temperatureRate(h)%p)
allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal)
end associate
enddo
end subroutine thermal_adiabatic_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates adiabatic change in temperature based on local heat generation model
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_updateState(subdt, ip, el)
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
subdt
logical, dimension(2) :: &
thermal_adiabatic_updateState
integer :: &
homog, &
offset
real(pReal) :: &
T, Tdot, dTdot_dT
homog = material_homogenizationAt(el)
offset = material_homogenizationMemberAt(ip,el)
T = thermalState(homog)%subState0(1,offset)
call thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
T = T + subdt*Tdot/(thermal_adiabatic_getSpecificHeat(ip,el)*thermal_adiabatic_getMassDensity(ip,el))
thermal_adiabatic_updateState = [ abs(T - thermalState(homog)%state(1,offset)) &
<= 1.0e-2_pReal &
.or. abs(T - thermalState(homog)%state(1,offset)) &
<= 1.0e-6_pReal*abs(thermalState(homog)%state(1,offset)), &
.true.]
temperature (homog)%p(thermalMapping(homog)%p(ip,el)) = T
temperatureRate(homog)%p(thermalMapping(homog)%p(ip,el)) = &
(thermalState(homog)%state(1,offset) - thermalState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal))
end function thermal_adiabatic_updateState
!--------------------------------------------------------------------------------------------------
!> @brief returns heat generation rate
!--------------------------------------------------------------------------------------------------
subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal), intent(in) :: &
T
real(pReal), intent(out) :: &
Tdot, dTdot_dT
integer :: &
homog
Tdot = 0.0_pReal
dTdot_dT = 0.0_pReal
homog = material_homogenizationAt(el)
call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S, crystallite_Lp, ip, el)
Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal)
dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal)
end subroutine thermal_adiabatic_getSourceAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized specific heat capacity
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_getSpecificHeat(ip,el)
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal) :: &
thermal_adiabatic_getSpecificHeat
integer :: &
grain
thermal_adiabatic_getSpecificHeat = 0.0_pReal
do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat &
+ lattice_c_p(material_phaseAt(grain,el))
enddo
thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat &
/ real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
end function thermal_adiabatic_getSpecificHeat
!--------------------------------------------------------------------------------------------------
!> @brief returns homogenized mass density
!--------------------------------------------------------------------------------------------------
function thermal_adiabatic_getMassDensity(ip,el)
integer, intent(in) :: &
ip, & !< integration point number
el !< element number
real(pReal) :: &
thermal_adiabatic_getMassDensity
integer :: &
grain
thermal_adiabatic_getMassDensity = 0.0_pReal
do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity &
+ lattice_rho(material_phaseAt(grain,el))
enddo
thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity &
/ real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
end function thermal_adiabatic_getMassDensity
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
subroutine thermal_adiabatic_results(homog,group)
integer, intent(in) :: homog
character(len=*), intent(in) :: group
integer :: o
associate(prm => param(damage_typeInstance(homog)))
outputsLoop: do o = 1,size(prm%output)
select case(trim(prm%output(o)))
case('T')
call results_writeDataset(group,temperature(homog)%p,'T',&
'temperature','K')
end select
enddo outputsLoop
end associate
end subroutine thermal_adiabatic_results
end module thermal_adiabatic

89
src/thermal_conduction.f90
View File

@ -8,9 +8,9 @@ module thermal_conduction
use config
use lattice
use results
use crystallite
use constitutive
use YAML_types
use discretization
implicit none
private
@ -25,7 +25,7 @@ module thermal_conduction
public :: &
thermal_conduction_init, &
thermal_conduction_getSourceAndItsTangent, &
thermal_conduction_getSource, &
thermal_conduction_getConductivity, &
thermal_conduction_getSpecificHeat, &
thermal_conduction_getMassDensity, &
@ -39,25 +39,28 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_init
subroutine thermal_conduction_init(T)
integer :: Ninstances,Nmaterialpoints,h
real(pReal), dimension(:), intent(inout) :: T
integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce
class(tNode), pointer :: &
material_homogenization, &
homog, &
homogThermal
print'(/,a)', ' <<<+- thermal_conduction init -+>>>'; flush(6)
Ninstances = count(thermal_type == THERMAL_conduction_ID)
allocate(param(Ninstances))
material_homogenization => config_material%get('homogenization')
do h = 1, size(material_name_homogenization)
if (thermal_type(h) /= THERMAL_conduction_ID) cycle
homog => material_homogenization%get(h)
do ho = 1, size(material_name_homogenization)
if (thermal_type(ho) /= THERMAL_conduction_ID) cycle
homog => material_homogenization%get(ho)
homogThermal => homog%get('thermal')
associate(prm => param(thermal_typeInstance(h)))
associate(prm => param(thermal_typeInstance(ho)))
#if defined (__GFORTRAN__)
prm%output = output_asStrings(homogThermal)
@ -65,28 +68,30 @@ subroutine thermal_conduction_init
prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray)
#endif
Nmaterialpoints=count(material_homogenizationAt==h)
thermalState(h)%sizeState = 0
allocate(thermalState(h)%state0 (0,Nmaterialpoints))
allocate(thermalState(h)%subState0(0,Nmaterialpoints))
allocate(thermalState(h)%state (0,Nmaterialpoints))
Nmaterialpoints=count(material_homogenizationAt==ho)
thermalMapping(h)%p => material_homogenizationMemberAt
deallocate(temperature (h)%p)
allocate (temperature (h)%p(Nmaterialpoints), source=thermal_initialT(h))
deallocate(temperatureRate(h)%p)
allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal)
allocate (temperature (ho)%p(Nmaterialpoints), source=thermal_initialT(ho))
allocate (temperatureRate(ho)%p(Nmaterialpoints), source=0.0_pReal)
end associate
enddo
ce = 0
do el = 1, discretization_Nelems
do ip = 1, discretization_nIPs
ce = ce + 1
ho = material_homogenizationAt(el)
if (thermal_type(ho) == THERMAL_conduction_ID) T(ce) = thermal_initialT(ho)
enddo
enddo
end subroutine thermal_conduction_init
!--------------------------------------------------------------------------------------------------
!> @brief return heat generation rate
!--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
subroutine thermal_conduction_getSource(Tdot, T,ip,el)
integer, intent(in) :: &
ip, & !< integration point number
@ -94,20 +99,17 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
real(pReal), intent(in) :: &
T
real(pReal), intent(out) :: &
Tdot, dTdot_dT
integer :: &
homog
Tdot = 0.0_pReal
dTdot_dT = 0.0_pReal
Tdot
homog = material_homogenizationAt(el)
call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S,crystallite_Lp ,ip, el)
integer :: &
homog
homog = material_homogenizationAt(el)
call constitutive_thermal_getRate(TDot, T,ip,el)
Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal)
dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal)
end subroutine thermal_conduction_getSourceAndItsTangent
end subroutine thermal_conduction_getSource
!--------------------------------------------------------------------------------------------------
@ -120,14 +122,16 @@ function thermal_conduction_getConductivity(ip,el)
el !< element number
real(pReal), dimension(3,3) :: &
thermal_conduction_getConductivity
integer :: &
grain
co
thermal_conduction_getConductivity = 0.0_pReal
do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
thermal_conduction_getConductivity = thermal_conduction_getConductivity + &
crystallite_push33ToRef(grain,ip,el,lattice_K(:,:,material_phaseAt(grain,el)))
crystallite_push33ToRef(co,ip,el,lattice_K(:,:,material_phaseAt(co,el)))
enddo
thermal_conduction_getConductivity = thermal_conduction_getConductivity &
@ -146,14 +150,16 @@ function thermal_conduction_getSpecificHeat(ip,el)
el !< element number
real(pReal) :: &
thermal_conduction_getSpecificHeat
integer :: &
grain
co
thermal_conduction_getSpecificHeat = 0.0_pReal
do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat &
+ lattice_c_p(material_phaseAt(grain,el))
+ lattice_c_p(material_phaseAt(co,el))
enddo
thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat &
@ -172,15 +178,16 @@ function thermal_conduction_getMassDensity(ip,el)
el !< element number
real(pReal) :: &
thermal_conduction_getMassDensity
integer :: &
grain
co
thermal_conduction_getMassDensity = 0.0_pReal
do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
thermal_conduction_getMassDensity = thermal_conduction_getMassDensity &
+ lattice_rho(material_phaseAt(grain,el))
+ lattice_rho(material_phaseAt(co,el))
enddo
thermal_conduction_getMassDensity = thermal_conduction_getMassDensity &
@ -205,7 +212,7 @@ subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el)
offset
homog = material_homogenizationAt(el)
offset = thermalMapping(homog)%p(ip,el)
offset = material_homogenizationMemberAt(ip,el)
temperature (homog)%p(offset) = T
temperatureRate(homog)%p(offset) = Tdot

33
src/thermal_isothermal.f90
View File

@ -3,8 +3,10 @@
!> @brief material subroutine for isothermal temperature field
!--------------------------------------------------------------------------------------------------
module thermal_isothermal
use prec
use config
use material
use discretization
implicit none
public
@ -14,28 +16,33 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates fields, reads information from material configuration file
!--------------------------------------------------------------------------------------------------
subroutine thermal_isothermal_init
subroutine thermal_isothermal_init(T)
integer :: h,Nmaterialpoints
real(pReal), dimension(:), intent(inout) :: T
integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce
print'(/,a)', ' <<<+- thermal_isothermal init -+>>>'; flush(6)
do h = 1, size(material_name_homogenization)
if (thermal_type(h) /= THERMAL_isothermal_ID) cycle
do ho = 1, size(thermal_type)
if (thermal_type(ho) /= THERMAL_isothermal_ID) cycle
Nmaterialpoints = count(material_homogenizationAt == h)
thermalState(h)%sizeState = 0
allocate(thermalState(h)%state0 (0,Nmaterialpoints))
allocate(thermalState(h)%subState0(0,Nmaterialpoints))
allocate(thermalState(h)%state (0,Nmaterialpoints))
Nmaterialpoints = count(material_homogenizationAt == ho)
deallocate(temperature (h)%p)
allocate (temperature (h)%p(1), source=thermal_initialT(h))
deallocate(temperatureRate(h)%p)
allocate (temperatureRate(h)%p(1))
allocate(temperature (ho)%p(Nmaterialpoints),source=thermal_initialT(ho))
allocate(temperatureRate(ho)%p(Nmaterialpoints),source = 0.0_pReal)
enddo
ce = 0
do el = 1, discretization_Nelems
do ip = 1, discretization_nIPs
ce = ce + 1
ho = material_homogenizationAt(el)
if (thermal_type(ho) == THERMAL_isothermal_ID) T(ce) = thermal_initialT(ho)
enddo
enddo
end subroutine thermal_isothermal_init
end module thermal_isothermal