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 10-consistent-orientation-conversions-3

This commit is contained in:
Martin Diehl 2019-02-22 23:05:36 +01:00
parent 43376c39d8 cc0e65c3b0
commit 93ae5cbd07
97 changed files with 7304 additions and 7204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
.gitlab-ci.yml
View File

@ -7,9 +7,9 @@ stages:
- compilePETScGNU
- prepareSpectral
- spectral
- compileMarc2018_1
- compileMarc
- marc
- compileAbaqus2017
- compileAbaqus
- example
- performance
- createPackage
@ -51,39 +51,37 @@ variables:
# Names of module files to load
# ===============================================================================================
# ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++
IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016"
IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4"
IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017"
IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018"
GNUCompiler7_3: "Compiler/GNU/7.3"
IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016"
IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017"
IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018"
GNUCompiler8_2: "Compiler/GNU/8.2"
# ------------ Defaults ----------------------------------------------
IntelCompiler: "$IntelCompiler18_1"
GNUCompiler: "$GNUCompiler7_3"
IntelCompiler: "$IntelCompiler18_4"
GNUCompiler: "$GNUCompiler8_2"
# ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++
MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1"
MPICH3_2GNU7_3: "MPI/GNU/7.3/MPICH/3.2.1"
IMPI2018Intel18_4: "MPI/Intel/18.4/IntelMPI/2018"
MPICH3_3GNU8_2: "MPI/GNU/8.2/MPICH/3.3"
# ------------ Defaults ----------------------------------------------
MPICH_Intel: "$MPICH3_2Intel18_1"
MPICH_GNU: "$MPICH3_2GNU7_3"
MPICH_Intel: "$IMPI2018Intel18_4"
MPICH_GNU: "$MPICH3_3GNU8_2"
# ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++
PETSc3_10_0MPICH3_2Intel18_1: "Libraries/PETSc/3.10.0/Intel-18.1-MPICH-3.2.1"
PETSc3_10_0MPICH3_2GNU7_3: "Libraries/PETSc/3.10.0/GNU-7.3-MPICH-3.2.1"
PETSc3_10_3IMPI2018Intel18_4: "Libraries/PETSc/3.10.3/Intel-18.4-IntelMPI-2018"
PETSc3_10_3MPICH3_3GNU8_2: "Libraries/PETSc/3.10.3/GNU-8.2-MPICH-3.3"
# ------------ Defaults ----------------------------------------------
PETSc_MPICH_Intel: "$PETSc3_10_0MPICH3_2Intel18_1"
PETSc_MPICH_GNU: "$PETSc3_10_0MPICH3_2GNU7_3"
PETSc_MPICH_Intel: "$PETSc3_10_3IMPI2018Intel18_4"
PETSc_MPICH_GNU: "$PETSc3_10_3MPICH3_3GNU8_2"
# ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++
Abaqus2017: "FEM/Abaqus/2017"
Abaqus2019: "FEM/Abaqus/2019"
MSC2018_1: "FEM/MSC/2018.1"
MSC2017: "FEM/MSC/2017"
# ------------ Defaults ----------------------------------------------
Abaqus: "$Abaqus2017"
Abaqus: "$Abaqus2019"
MSC: "$MSC2018_1"
IntelMarc: "$IntelCompiler17_0"
IntelMarc: "$IntelCompiler17_8"
IntelAbaqus: "$IntelCompiler16_4"
# ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++
Doxygen1_8_13: "Documentation/Doxygen/1.8.13"
Doxygen1_8_15: "Documentation/Doxygen/1.8.15"
# ------------ Defaults ----------------------------------------------
Doxygen: "$Doxygen1_8_13"
Doxygen: "$Doxygen1_8_15"
###################################################################################################
@ -158,6 +156,13 @@ Post_AverageDown:
- master
- release
Post_ASCIItable:
stage: postprocessing
script: ASCIItable/test.py
except:
- master
- release
Post_General:
stage: postprocessing
script: PostProcessing/test.py
@ -383,9 +388,9 @@ TextureComponents:
###################################################################################################
Marc_compileIfort2018_1:
stage: compileMarc2018_1
stage: compileMarc
script:
- module load $IntelCompiler17_0 $MSC2018_1
- module load $IntelMarc $MSC
- Marc_compileIfort/test.py -m 2018.1
except:
- master
@ -430,11 +435,11 @@ J2_plasticBehavior:
- release
###################################################################################################
Abaqus_compile2017:
stage: compileAbaqus2017
Abaqus_compile:
stage: compileAbaqus
script:
- module load $IntelCompiler16_4 $Abaqus2017
- Abaqus_compileIfort/test.py -a 2017
- module load $IntelAbaqus $Abaqus
- Abaqus_compileIfort/test.py
except:
- master
- release
@ -477,24 +482,40 @@ AbaqusStd:
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
- $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT abaqus
only:
- development
except:
- master
- release
Marc:
stage: createDocumentation
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
- $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT marc
only:
- development
except:
- master
- release
Spectral:
stage: createDocumentation
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
- $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT spectral
only:
- development
except:
- master
- release
Processing:
stage: createDocumentation
script:
- cd $DAMASKROOT/processing/pre
- rm 3DRVEfrom2Dang.py abq_addUserOutput.py marc_addUserOutput.py
- $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py
- cd $DAMASKROOT/processing/post
- rm marc_to_vtk.py vtk2ang.py
- $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py
except:
- master
- release
##################################################################################################
backupData:
@ -503,11 +524,10 @@ backupData:
- cd $TESTROOT/performance # location of new runtime results
- git commit -am"${CI_PIPELINE_ID}_${CI_COMMIT_SHA}"
- mkdir $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}
- cp $TESTROOT/performance/time.txt $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/
- mv $TESTROOT/performance/time.png $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/
- cp $TESTROOT/performance/memory.txt $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/
- mv $TESTROOT/performance/memory.png $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/
- mv $DAMASKROOT/PRIVATE/documenting/DAMASK_* $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/
- mv $DAMASKROOT/processing $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/
only:
- development

27
CMakeLists.txt
View File

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

2
CONFIG
View File

@ -8,6 +8,6 @@ set DAMASK_NUM_THREADS = 4
set MSC_ROOT = /opt/msc
set MARC_VERSION = 2018.1
set ABAQUS_VERSION = 2017
set ABAQUS_VERSION = 2019
set DAMASK_HDF5 = OFF

2
PRIVATE

@ -1 +1 @@
Subproject commit 406d482f8059b4459634af729ce85491a9a3245c
Subproject commit e86418193f202364e068de2dffee36f99c846856

1
README
View File

@ -10,3 +10,4 @@ Germany
Email: DAMASK@mpie.de
https://damask.mpie.de
https://magit1.mpie.de

2
VERSION
View File

@ -1 +1 @@
v2.0.2-1667-g6b66563b
v2.0.2-1837-g3bec76e7

15
processing/post/addAPS34IDEstrainCoords.py
View File

@ -14,20 +14,15 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Transform X,Y,Z,F APS BeamLine 34 coordinates to x,y,z APS strain coordinates.
""", version = scriptID)
parser.add_option('-f',
'--frame',
dest='frame',
metavar='string',
help='APS X,Y,Z coords')
parser.add_option('--depth',
dest='depth',
metavar='string',
help='depth')
parser.add_option('-f','--frame',dest='frame', metavar='string',
help='label of APS X,Y,Z coords')
parser.add_option('--depth', dest='depth', metavar='string',
help='depth')
(options,filenames) = parser.parse_args()

19
processing/post/addCalculation.py
View File

@ -18,7 +18,7 @@ def listify(x):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add or alter column(s) with derived values according to user-defined arithmetic operation between column(s).
Column labels are tagged by '#label#' in formulas. Use ';' for ',' in functions.
Numpy is available as 'np'.
@ -41,10 +41,7 @@ parser.add_option('-f','--formula',
parser.add_option('-c','--condition',
dest = 'condition', metavar='string',
help = 'condition to alter existing column data')
parser.set_defaults(condition = None,
)
help = 'condition to alter existing column data (optional)')
(options,filenames) = parser.parse_args()
@ -80,7 +77,7 @@ for name in filenames:
condition = options.condition # copy per file, since might be altered inline
breaker = False
for position,(all,marker,column) in enumerate(set(re.findall(r'#(([s]#)?(.+?))#',condition))): # find three groups
for position,(all,marker,column) in enumerate(set(re.findall(r'#(([s]#)?(.+?))#',condition))): # find three groups
idx = table.label_index(column)
dim = table.label_dimension(column)
if idx < 0 and column not in specials:
@ -89,15 +86,15 @@ for name in filenames:
else:
if column in specials:
replacement = 'specials["{}"]'.format(column)
elif dim == 1: # scalar input
elif dim == 1: # scalar input
replacement = '{}(table.data[{}])'.format({ '':'float',
's#':'str'}[marker],idx) # take float or string value of data column
elif dim > 1: # multidimensional input (vector, tensor, etc.)
replacement = 'np.array(table.data[{}:{}],dtype=float)'.format(idx,idx+dim) # use (flat) array representation
's#':'str'}[marker],idx) # take float or string value of data column
elif dim > 1: # multidimensional input (vector, tensor, etc.)
replacement = 'np.array(table.data[{}:{}],dtype=float)'.format(idx,idx+dim) # use (flat) array representation
condition = condition.replace('#'+all+'#',replacement)
if breaker: continue # found mistake in condition evaluation --> next file
if breaker: continue # found mistake in condition evaluation --> next file
# ------------------------------------------ build formulas ----------------------------------------

4
processing/post/addCauchy.py
View File

@ -13,8 +13,8 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
Add column(s) containing Cauchy stress based on given column(s) of deformation gradient and first Piola--Kirchhoff stress.
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column containing Cauchy stress based on deformation gradient and first Piola--Kirchhoff stress.
""", version = scriptID)

2
processing/post/addCompatibilityMismatch.py
View File

@ -209,7 +209,7 @@ def shapeMismatch(size,F,nodes,centres):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options file[s]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing the shape and volume mismatch resulting from given deformation gradient.
Operates on periodic three-dimensional x,y,z-ordered data sets.

9
processing/post/addCumulative.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys
@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add cumulative (sum of first to current row) values for given label(s).
""", version = scriptID)
@ -22,12 +22,9 @@ parser.add_option('-l','--label',
action = 'extend', metavar = '<string LIST>',
help = 'columns to cumulate')
parser.set_defaults(label = [],
)
(options,filenames) = parser.parse_args()
if len(options.label) == 0:
if options.label is None:
parser.error('no data column(s) specified.')
# --- loop over input files -------------------------------------------------------------------------

4
processing/post/addCurl.py
View File

@ -49,14 +49,14 @@ def curlFFT(geomdim,field):
curl_fourier = np.einsum(einsums[n],e,k_s,field_fourier)*TWOPIIMG
return np.fft.irfftn(curl_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,n])
return np.fft.irfftn(curl_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n])
# --------------------------------------------------------------------
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing curl of requested column(s).
Operates on periodic ordered three-dimensional data sets
of vector and tensor fields.

4
processing/post/addDerivative.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys
@ -34,7 +34,7 @@ def derivative(coordinates,what):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing numerical derivative of requested column(s) with respect to given coordinates.
""", version = scriptID)

2
processing/post/addDeterminant.py
View File

@ -20,7 +20,7 @@ def determinant(m):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing determinant of requested tensor column(s).
""", version = scriptID)

2
processing/post/addDeviator.py
View File

@ -23,7 +23,7 @@ def deviator(m,spherical = False):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(2)]', description = """
Add column(s) containing deviator of requested tensor column(s).
""", version = scriptID)

3
processing/post/addDisplacement.py
View File

@ -87,7 +87,7 @@ def displacementFluctFFT(F,grid,size,nodal=False,transformed=False):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options] [ASCIItable(s)]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add displacments resulting from deformation gradient field.
Operates on periodic three-dimensional x,y,z-ordered data sets.
Outputs at cell centers or cell nodes (into separate file).
@ -111,7 +111,6 @@ parser.add_option('--nodal',
parser.set_defaults(defgrad = 'f',
pos = 'pos',
nodal = False,
)
(options,filenames) = parser.parse_args()

2
processing/post/addDivergence.py
View File

@ -45,7 +45,7 @@ def divFFT(geomdim,field):
div_fourier = np.einsum(einsums[n],k_s,field_fourier)*TWOPIIMG
return np.fft.irfftn(div_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,n//3])
return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n//3])
# --------------------------------------------------------------------

2
processing/post/addEhkl.py
View File

@ -30,7 +30,7 @@ def E_hkl(stiffness,vec): # stiffness = (c11,c12,c44)
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing directional stiffness based on given cubic stiffness values C11, C12, and C44 in consecutive columns.
""", version = scriptID)

2
processing/post/addEuclideanDistance.py
View File

@ -83,7 +83,7 @@ neighborhoods = {
])
}
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing Euclidean distance to grain structural features: boundaries, triple lines, and quadruple points.
""", version = scriptID)

7
processing/post/addGaussian.py
View File

@ -15,7 +15,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [ASCIItable(s)]', description = """
Add column(s) containing Gaussian filtered values of requested column(s).
Operates on periodic and non-periodic ordered three-dimensional data sets.
For details see scipy.ndimage documentation.
@ -34,12 +34,12 @@ parser.add_option('-o','--order',
dest = 'order',
type = int,
metavar = 'int',
help = 'order of the filter')
help = 'order of the filter [%default]')
parser.add_option('--sigma',
dest = 'sigma',
type = float,
metavar = 'float',
help = 'standard deviation')
help = 'standard deviation [%default]')
parser.add_option('--periodic',
dest = 'periodic',
action = 'store_true',
@ -50,7 +50,6 @@ parser.add_option('--periodic',
parser.set_defaults(pos = 'pos',
order = 0,
sigma = 1,
periodic = False,
)
(options,filenames) = parser.parse_args()

4
processing/post/addGradient.py
View File

@ -45,14 +45,14 @@ def gradFFT(geomdim,field):
k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16')
grad_fourier = np.einsum(einsums[n],field_fourier,k_s)*TWOPIIMG
return np.fft.irfftn(grad_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,3*n])
return np.fft.irfftn(grad_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,3*n])
# --------------------------------------------------------------------
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [ASCIItable(s)]', description = """
Add column(s) containing gradient of requested column(s).
Operates on periodic ordered three-dimensional data sets
of vector and scalar fields.

6
processing/post/addGrainID.py
View File

@ -28,9 +28,9 @@ parser.add_option('-d',
help = 'disorientation threshold in degrees [%default]')
parser.add_option('-s',
'--symmetry',
dest = 'symmetry',
dest = 'symmetry', type = 'choice', choices = damask.Symmetry.lattices[1:],
metavar = 'string',
help = 'crystal symmetry [%default]')
help = 'crystal symmetry [%default] {{{}}} '.format(', '.join(damask.Symmetry.lattices[1:])))
parser.add_option('-o',
'--orientation',
dest = 'quaternion',
@ -49,7 +49,7 @@ parser.add_option('--quiet',
parser.set_defaults(disorientation = 5,
verbose = True,
quaternion = 'orientation',
symmetry = 'cubic',
symmetry = damask.Symmetry.lattices[-1],
pos = 'pos',
)

2
processing/post/addIPFcolor.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add RGB color value corresponding to TSL-OIM scheme for inverse pole figures.
""", version = scriptID)

2
processing/post/addIndexed.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add data in column(s) of mapped ASCIItable selected from the row indexed by the value in a mapping column.
Row numbers start at 1.

7
processing/post/addInfo.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options file[s]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add info lines to ASCIItable header.
""", version = scriptID)
@ -23,11 +23,12 @@ parser.add_option('-i',
dest = 'info', action = 'extend', metavar = '<string LIST>',
help = 'items to add')
parser.set_defaults(info = [],
)
(options,filenames) = parser.parse_args()
if options.info is None:
parser.error('no info specified.')
# --- loop over input files ------------------------------------------------------------------------
if filenames == []: filenames = [None]

9
processing/post/addLinked.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys
@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add data of selected column(s) from (first) row of linked ASCIItable that shares the linking column value.
""", version = scriptID)
@ -21,7 +21,7 @@ Add data of selected column(s) from (first) row of linked ASCIItable that shares
parser.add_option('--link',
dest = 'link', nargs = 2,
type = 'string', metavar = 'string string',
help = 'column labels containing linked values')
help = 'column labels of table and linked table containing linking values')
parser.add_option('-l','--label',
dest = 'label',
action = 'extend', metavar = '<string LIST>',
@ -105,7 +105,8 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
try:
table.data_append(data[np.argwhere(np.all((map(float,table.data[myLink:myLink+myLinkDim]) - index)==0,axis=1))[0]]) # add data of first matching line
table.data_append(data[np.argwhere(np.all((list(map(float,table.data[myLink:myLink+myLinkDim])) - index)==0,
axis=1))[0]]) # add data of first matching line
except IndexError:
table.data_append(np.nan*np.ones_like(data[0])) # or add NaNs
outputAlive = table.data_write() # output processed line

8
processing/post/addMises.py
View File

@ -24,7 +24,7 @@ def Mises(what,tensor):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add vonMises equivalent values for symmetric part of requested strains and/or stresses.
""", version = scriptID)
@ -38,13 +38,9 @@ parser.add_option('-s','--stress',
action = 'extend', metavar = '<string LIST>',
help = 'heading(s) of columns containing stress tensors')
parser.set_defaults(strain = [],
stress = [],
)
(options,filenames) = parser.parse_args()
if len(options.stress+options.strain) == 0:
if options.stress is None and options.strain is None:
parser.error('no data column specified...')
# --- loop over input files -------------------------------------------------------------------------

9
processing/post/addNorm.py
View File

@ -9,6 +9,7 @@ scriptName = os.path.splitext(os.path.basename(__file__))[0]
scriptID = ' '.join([scriptName,damask.version])
# definition of element-wise p-norms for matrices
# ToDo: better use numpy.linalg.norm
def norm(which,object):
@ -18,12 +19,14 @@ def norm(which,object):
return math.sqrt(sum([x*x for x in object]))
elif which == 'Max': # p = inf
return max(map(abs, object))
else:
return -1
# --------------------------------------------------------------------
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing norm of requested column(s) being either vectors or tensors.
""", version = scriptID)
@ -43,6 +46,8 @@ parser.set_defaults(norm = 'frobenius',
(options,filenames) = parser.parse_args()
if options.norm.lower() not in normChoices:
parser.error('invalid norm ({}) specified.'.format(options.norm))
if options.label is None:
parser.error('no data column specified.')
@ -74,7 +79,7 @@ for name in filenames:
else:
dims.append(dim)
columns.append(table.label_index(what))
table.labels_append('norm{}({})'.format(options.norm.capitalize(),what)) # extend ASCII header with new labels
table.labels_append('norm{}({})'.format(options.norm.capitalize(),what)) # extend ASCII header with new labels
if remarks != []: damask.util.croak(remarks)
if errors != []:

7
processing/post/addOrientations.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add quaternion and/or Bunge Euler angle representation of crystal lattice orientation.
Orientation is given by quaternion, Euler angles, rotation matrix, or crystal frame coordinates
(i.e. component vectors of rotation matrix).
@ -43,12 +43,12 @@ parser.add_option('-R',
'--labrotation',
dest='labrotation',
type = 'float', nargs = 4, metavar = ' '.join(['float']*4),
help = 'angle and axis of additional lab frame rotation')
help = 'angle and axis of additional lab frame rotation [%default]')
parser.add_option('-r',
'--crystalrotation',
dest='crystalrotation',
type = 'float', nargs = 4, metavar = ' '.join(['float']*4),
help = 'angle and axis of additional crystal frame rotation')
help = 'angle and axis of additional crystal frame rotation [%default]')
parser.add_option('--eulers',
dest = 'eulers',
metavar = 'string',
@ -81,7 +81,6 @@ parser.add_option('-z',
parser.set_defaults(output = [],
labrotation = (0.,1.,0.,0.), # no rotation about 1,0,0
crystalrotation = (0.,1.,0.,0.), # no rotation about 1,0,0
degrees = False,
)
(options, filenames) = parser.parse_args()

2
processing/post/addPK2.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing Second Piola--Kirchhoff stress based on given column(s) of deformation
gradient and first Piola--Kirchhoff stress.

3
processing/post/addPole.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add coordinates of stereographic projection of given direction (pole) in crystal frame.
""", version = scriptID)
@ -35,7 +35,6 @@ parser.add_option('-o',
parser.set_defaults(pole = (1.0,0.0,0.0),
quaternion = 'orientation',
polar = False,
)
(options, filenames) = parser.parse_args()

4
processing/post/addSchmidfactors.py
View File

@ -103,7 +103,7 @@ slipSystems = {
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add columns listing Schmid factors (and optional trace vector of selected system) for given Euler angles.
""", version = scriptID)
@ -115,7 +115,7 @@ parser.add_option('-l',
help = 'type of lattice structure [%default] {}'.format(latticeChoices))
parser.add_option('--covera',
dest = 'CoverA', type = 'float', metavar = 'float',
help = 'C over A ratio for hexagonal systems')
help = 'C over A ratio for hexagonal systems [%default]')
parser.add_option('-f',
'--force',
dest = 'force',

2
processing/post/addSpectralDecomposition.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing eigenvalues and eigenvectors of requested symmetric tensor column(s).
""", version = scriptID)

11
processing/post/addStrainTensors.py
View File

@ -25,7 +25,7 @@ def operator(stretch,strain,eigenvalues):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Add column(s) containing given strains based on given stretches of requested deformation gradient column(s).
""", version = scriptID)
@ -56,16 +56,15 @@ parser.add_option('-f','--defgrad',
metavar = '<string LIST>',
help = 'heading(s) of columns containing deformation tensor values [%default]')
parser.set_defaults(right = False,
left = False,
logarithmic = False,
biot = False,
green = False,
parser.set_defaults(
defgrad = ['f'],
)
(options,filenames) = parser.parse_args()
if len(options.defgrad) > 1:
options.defgrad = options.defgrad[1:]
stretches = []
strains = []

8
processing/post/addTable.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys
@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Append data of ASCIItable(s).
""", version = scriptID)
@ -24,6 +24,10 @@ parser.add_option('-a', '--add','--table',
(options,filenames) = parser.parse_args()
if options.table is None:
parser.error('no table specified.')
# --- loop over input files -------------------------------------------------------------------------
if filenames == []: filenames = [None]

10
processing/post/averageDown.py
View File

@ -14,7 +14,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Average each data block of size 'packing' into single values thus reducing the former grid to grid/packing.
""", version = scriptID)
@ -34,16 +34,14 @@ parser.add_option('--shift',
parser.add_option('-g', '--grid',
dest = 'grid',
type = 'int', nargs = 3, metavar = 'int int int',
help = 'grid in x,y,z [autodetect]')
help = 'grid in x,y,z (optional)')
parser.add_option('-s', '--size',
dest = 'size',
type = 'float', nargs = 3, metavar = 'float float float',
help = 'size in x,y,z [autodetect]')
help = 'size in x,y,z (optional)')
parser.set_defaults(pos = 'pos',
packing = (2,2,2),
shift = (0,0,0),
grid = (0,0,0),
size = (0.0,0.0,0.0),
)
(options,filenames) = parser.parse_args()
@ -92,7 +90,7 @@ for name in filenames:
table.data_readArray()
if (any(options.grid) == 0 or any(options.size) == 0.0):
if (options.grid is None or options.size is None):
grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)])
else:
grid = np.array(options.grid,'i')

11
processing/post/binXY.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Produces a binned grid of two columns from an ASCIItable, i.e. a two-dimensional probability density map.
""", version = scriptID)
@ -37,15 +37,15 @@ parser.add_option('-t','--type',
parser.add_option('-x','--xrange',
dest = 'xrange',
type = 'float', nargs = 2, metavar = 'float float',
help = 'min max value in x direction [autodetect]')
help = 'min max limits in x direction (optional)')
parser.add_option('-y','--yrange',
dest = 'yrange',
type = 'float', nargs = 2, metavar = 'float float',
help = 'min max value in y direction [autodetect]')
help = 'min max limits in y direction (optional)')
parser.add_option('-z','--zrange',
dest = 'zrange',
type = 'float', nargs = 2, metavar = 'float float',
help = 'min max value in z direction [autodetect]')
help = 'min max limits in z direction (optional)')
parser.add_option('-i','--invert',
dest = 'invert',
action = 'store_true',
@ -64,9 +64,6 @@ parser.set_defaults(bins = (10,10),
xrange = (0.0,0.0),
yrange = (0.0,0.0),
zrange = (0.0,0.0),
invert = False,
normRow = False,
normCol = False,
)
(options,filenames) = parser.parse_args()

8
processing/post/blowUp.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys
@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Blows up each value to a surrounding data block of size 'packing' thus increasing the former resolution
to resolution*packing.
@ -27,10 +27,10 @@ parser.add_option('-p','--packing',
help = 'dimension of packed group [%default]')
parser.add_option('-g','--grid',
dest = 'resolution', type = 'int', nargs = 3, metavar = 'int int int',
help = 'resolution in x,y,z [autodetect]')
help = 'grid in x,y,z (optional)')
parser.add_option('-s','--size',
dest = 'dimension', type = 'float', nargs = 3, metavar = 'int int int',
help = 'dimension in x,y,z [autodetect]')
help = 'size in x,y,z (optional)')
parser.set_defaults(pos = 'pos',
packing = (2,2,2),
grid = (0,0,0),

2
processing/post/filterTable.py
View File

@ -30,7 +30,7 @@ def sortingList(labels,whitelistitems):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Filter rows according to condition and columns by either white or black listing.
Examples:

2
processing/post/groupTable.py
View File

@ -20,7 +20,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Apply a user-specified function to condense into a single row all those rows for which columns 'label' have identical values.
Output table will contain as many rows as there are different (unique) values in the grouping column(s).
Periodic domain averaging of coordinate values is supported.

2
processing/post/permuteData.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Permute all values in given column(s).
""", version = scriptID)

2
processing/post/reLabel.py
View File

@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options] dfile[s]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Rename scalar, vectorial, and/or tensorial data header labels.
""", version = scriptID)

4
processing/post/rotateData.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Rotate vector and/or tensor column data by given angle around given axis.
""", version = scriptID)
@ -29,7 +29,7 @@ parser.add_option('-r', '--rotation',
parser.add_option('--degrees',
dest = 'degrees',
action = 'store_true',
help = 'angle is given in degrees [%default]')
help = 'angles are given in degrees')
parser.set_defaults(rotation = (0.,1.,0.,0.), # no rotation about 1,0,0
degrees = False,

2
processing/post/scaleData.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Uniformly scale column values by given factor.
""", version = scriptID)

2
processing/post/shiftData.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Uniformly shift column values by given offset.
""", version = scriptID)

2
processing/post/sortTable.py
View File

@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Sort rows by given (or all) column label(s).
Examples:

2
processing/post/viewTable.py
View File

@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(usage='%prog [options] [file[s]]', description = """
parser = OptionParser(usage='%prog options [ASCIItable(s)]', description = """
Show components of given ASCIItable(s).
""", version = scriptID)

17
processing/post/vtk_addGridData.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,vtk
@ -17,7 +17,7 @@ scriptID = ' '.join([scriptName,damask.version])
msg = "Add scalars, vectors, and/or an RGB tuple from"
msg += "an ASCIItable to existing VTK grid (.vtr/.vtk/.vtu)."
parser = OptionParser(option_class=damask.extendableOption,
usage='%prog options [file[s]]',
usage='%prog options [ASCIItable(s)]',
description = msg,
version = scriptID)
@ -25,10 +25,6 @@ parser.add_option( '--vtk',
dest = 'vtk',
type = 'string', metavar = 'string',
help = 'VTK file name')
parser.add_option( '--inplace',
dest = 'inplace',
action = 'store_true',
help = 'modify VTK file in-place')
parser.add_option('-r', '--render',
dest = 'render',
action = 'store_true',
@ -49,7 +45,6 @@ parser.add_option('-c', '--color',
parser.set_defaults(data = [],
tensor = [],
color = [],
inplace = False,
render = False,
)
@ -64,24 +59,23 @@ if os.path.splitext(options.vtk)[1] == '.vtr':
reader.Update()
rGrid = reader.GetOutput()
writer = vtk.vtkXMLRectilinearGridWriter()
writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr'))
elif os.path.splitext(options.vtk)[1] == '.vtk':
reader = vtk.vtkGenericDataObjectReader()
reader.SetFileName(options.vtk)
reader.Update()
rGrid = reader.GetRectilinearGridOutput()
writer = vtk.vtkXMLRectilinearGridWriter()
writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr'))
elif os.path.splitext(options.vtk)[1] == '.vtu':
reader = vtk.vtkXMLUnstructuredGridReader()
reader.SetFileName(options.vtk)
reader.Update()
rGrid = reader.GetOutput()
writer = vtk.vtkXMLUnstructuredGridWriter()
writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtu' if options.inplace else '_added.vtu'))
else:
parser.error('Unsupported VTK file type extension.')
writer.SetFileName(options.vtk)
Npoints = rGrid.GetNumberOfPoints()
Ncells = rGrid.GetNumberOfCells()
@ -172,8 +166,7 @@ for name in filenames:
writer.SetDataModeToBinary()
writer.SetCompressorTypeToZLib()
if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid)
else: writer.SetInputData(rGrid)
writer.SetInputData(rGrid)
writer.Write()
# ------------------------------------------ render result ---------------------------------------

16
processing/post/vtk_addPointcloudData.py → processing/post/vtk_addPointCloudData.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,vtk
@ -15,7 +15,7 @@ scriptID = ' '.join([scriptName,damask.version])
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption,
usage='%prog options [file[s]]',
usage='%prog options [ASCIItable(s)]',
description = """Add scalar and RGB tuples from ASCIItable to existing VTK point cloud (.vtp).""",
version = scriptID)
@ -23,10 +23,6 @@ parser.add_option( '--vtk',
dest = 'vtk',
type = 'string', metavar = 'string',
help = 'VTK file name')
parser.add_option( '--inplace',
dest = 'inplace',
action = 'store_true',
help = 'modify VTK file in-place')
parser.add_option('-r', '--render',
dest = 'render',
action = 'store_true',
@ -46,8 +42,6 @@ parser.add_option('-c', '--color', dest='color', action='extend',
parser.set_defaults(data = [],
tensor = [],
color = [],
inplace = False,
render = False,
)
(options, filenames) = parser.parse_args()
@ -151,14 +145,12 @@ for name in filenames:
# ------------------------------------------ output result ---------------------------------------
Polydata.Modified()
if vtk.VTK_MAJOR_VERSION <= 5: Polydata.Update()
writer = vtk.vtkXMLPolyDataWriter()
writer.SetDataModeToBinary()
writer.SetCompressorTypeToZLib()
writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtp' if options.inplace else '_added.vtp'))
if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(Polydata)
else: writer.SetInputData(Polydata)
writer.SetFileName(options.vtk)
writer.SetInputData(Polydata)
writer.Write()
# ------------------------------------------ render result ---------------------------------------

13
processing/post/vtk_addRectilinearGridData.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,vtk
@ -25,10 +25,6 @@ parser.add_option( '--vtk',
dest = 'vtk',
type = 'string', metavar = 'string',
help = 'VTK file name')
parser.add_option( '--inplace',
dest = 'inplace',
action = 'store_true',
help = 'modify VTK file in-place')
parser.add_option('-r', '--render',
dest = 'render',
action = 'store_true',
@ -49,7 +45,6 @@ parser.add_option('-c', '--color',
parser.set_defaults(data = [],
tensor = [],
color = [],
inplace = False,
render = False,
)
@ -158,16 +153,14 @@ for name in filenames:
elif mode == 'point': rGrid.GetPointData().AddArray(VTKarray[me])
rGrid.Modified()
if vtk.VTK_MAJOR_VERSION <= 5: rGrid.Update()
# ------------------------------------------ output result ---------------------------------------
writer = vtk.vtkXMLRectilinearGridWriter()
writer.SetDataModeToBinary()
writer.SetCompressorTypeToZLib()
writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr'))
if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid)
else: writer.SetInputData(rGrid)
writer.SetFileName(options.vtk)
writer.SetInputData(rGrid)
writer.Write()
# ------------------------------------------ render result ---------------------------------------

9
processing/post/vtk_pointcloud.py → processing/post/vtk_pointCloud.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys,vtk
@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Produce a VTK point cloud dataset based on coordinates given in an ASCIItable.
""", version = scriptID)
@ -78,7 +78,6 @@ for name in filenames:
Polydata.SetPoints(Points)
Polydata.SetVerts(Vertices)
Polydata.Modified()
if vtk.VTK_MAJOR_VERSION <= 5: Polydata.Update()
# ------------------------------------------ output result ---------------------------------------
@ -94,8 +93,8 @@ for name in filenames:
writer.SetHeader('# powered by '+scriptID)
writer.WriteToOutputStringOn()
if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(Polydata)
else: writer.SetInputData(Polydata)
writer.SetInputData(Polydata)
writer.Write()

7
processing/post/vtk_rectilinearGrid.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys,vtk
@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version])
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """
Create regular voxel grid from points in an ASCIItable.
""", version = scriptID)
@ -125,8 +125,7 @@ for name in filenames:
writer.SetHeader('# powered by '+scriptID)
writer.WriteToOutputStringOn()
if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid)
else: writer.SetInputData(rGrid)
writer.SetInputData(rGrid)
writer.Write()

2
processing/pre/geom_addPrimitive.py
View File

@ -25,7 +25,7 @@ mappings = {
'microstructures': lambda x: int(x),
}
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [geomfile(s)]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [geomfile(s)]', description = """
Positions a geometric object within the (three-dimensional) canvas of a spectral geometry description.
Depending on the sign of the dimension parameters, these objects can be boxes, cylinders, or ellipsoids.

2
processing/pre/geom_clean.py
View File

@ -18,7 +18,7 @@ def mostFrequent(arr):
# MAIN
#--------------------------------------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [geomfile(s)]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [geomfile(s)]', description = """
Smooth geometry by selecting most frequent microstructure index within given stencil at each location.
""", version=scriptID)

47
processing/pre/geom_grainGrowth.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys,math
@ -49,7 +49,7 @@ parser.set_defaults(d = 1,
(options, filenames) = parser.parse_args()
options.immutable = map(int,options.immutable)
options.immutable = list(map(int,options.immutable))
getInterfaceEnergy = lambda A,B: np.float32((A*B != 0)*(A != B)*1.0) # 1.0 if A & B are distinct & nonzero, 0.0 otherwise
struc = ndimage.generate_binary_structure(3,1) # 3D von Neumann neighborhood
@ -70,9 +70,9 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))),
'size x y z: {}'.format(' x '.join(map(str,info['size']))),
'origin x y z: {}'.format(' : '.join(map(str,info['origin']))),
damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))),
'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))),
'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
@ -102,9 +102,9 @@ for name in filenames:
gauss = np.exp(-(X*X + Y*Y + Z*Z)/(2.0*options.d*options.d),dtype=np.float32) \
/np.power(2.0*np.pi*options.d*options.d,(3.0 - np.count_nonzero(info['grid'] == 1))/2.,dtype=np.float32)
gauss[:,:,:grid[2]/2:-1] = gauss[:,:,1:(grid[2]+1)/2] # trying to cope with uneven (odd) grid size
gauss[:,:grid[1]/2:-1,:] = gauss[:,1:(grid[1]+1)/2,:]
gauss[:grid[0]/2:-1,:,:] = gauss[1:(grid[0]+1)/2,:,:]
gauss[:,:,:grid[2]//2:-1] = gauss[:,:,1:(grid[2]+1)//2] # trying to cope with uneven (odd) grid size
gauss[:,:grid[1]//2:-1,:] = gauss[:,1:(grid[1]+1)//2,:]
gauss[:grid[0]//2:-1,:,:] = gauss[1:(grid[0]+1)//2,:,:]
gauss = np.fft.rfftn(gauss).astype(np.complex64)
for smoothIter in range(options.N):
@ -119,9 +119,9 @@ for name in filenames:
microstructure,i,axis=0), j,axis=1), k,axis=2)))
# periodically extend interfacial energy array by half a grid size in positive and negative directions
periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]/2:-grid[0]/2,
grid[1]/2:-grid[1]/2,
grid[2]/2:-grid[2]/2]
periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]//2:-grid[0]//2,
grid[1]//2:-grid[1]//2,
grid[2]//2:-grid[2]//2]
# transform bulk volume (i.e. where interfacial energy remained zero), store index of closest boundary voxel
index = ndimage.morphology.distance_transform_edt(periodic_interfaceEnergy == 0.,
@ -148,15 +148,15 @@ for name in filenames:
ndimage.morphology.binary_dilation(interfaceEnergy > 0.,
structure = struc,
iterations = int(round(options.d*2.))-1),# fat boundary
periodic_bulkEnergy[grid[0]/2:-grid[0]/2, # retain filled energy on fat boundary...
grid[1]/2:-grid[1]/2,
grid[2]/2:-grid[2]/2], # ...and zero everywhere else
periodic_bulkEnergy[grid[0]//2:-grid[0]//2, # retain filled energy on fat boundary...
grid[1]//2:-grid[1]//2,
grid[2]//2:-grid[2]//2], # ...and zero everywhere else
0.)).astype(np.complex64) *
gauss).astype(np.float32)
periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]/2:-grid[0]/2,
grid[1]/2:-grid[1]/2,
grid[2]/2:-grid[2]/2] # periodically extend the smoothed bulk energy
periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]//2:-grid[0]//2,
grid[1]//2:-grid[1]//2,
grid[2]//2:-grid[2]//2] # periodically extend the smoothed bulk energy
# transform voxels close to interface region
@ -164,15 +164,15 @@ for name in filenames:
return_distances = False,
return_indices = True) # want index of closest bulk grain
periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]/2:-grid[0]/2,
grid[1]/2:-grid[1]/2,
grid[2]/2:-grid[2]/2] # periodically extend the microstructure
periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]//2:-grid[0]//2,
grid[1]//2:-grid[1]//2,
grid[2]//2:-grid[2]//2] # periodically extend the microstructure
microstructure = periodic_microstructure[index[0],
index[1],
index[2]].reshape(2*grid)[grid[0]/2:-grid[0]/2,
grid[1]/2:-grid[1]/2,
grid[2]/2:-grid[2]/2] # extent grains into interface region
index[2]].reshape(2*grid)[grid[0]//2:-grid[0]//2,
grid[1]//2:-grid[1]//2,
grid[2]//2:-grid[2]//2] # extent grains into interface region
# replace immutable microstructures with closest mutable ones
index = ndimage.morphology.distance_transform_edt(np.in1d(microstructure,options.immutable).reshape(grid),
@ -236,3 +236,4 @@ for name in filenames:
# --- output finalization --------------------------------------------------------------------------
table.close()

14
processing/pre/geom_toTable.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys
@ -48,11 +48,11 @@ for name in filenames:
table.head_read()
info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures'],
damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))),
'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))),
'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))),
'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']),
])
errors = []
@ -86,7 +86,7 @@ for name in filenames:
yy = np.tile(np.repeat(y,info['grid'][0] ),info['grid'][2])
zz = np.repeat(z,info['grid'][0]*info['grid'][1])
table.data = np.squeeze(np.dstack((xx,yy,zz,microstructure)))
table.data = np.squeeze(np.dstack((xx,yy,zz,microstructure)),axis=0)
table.data_writeArray()
# ------------------------------------------ finalize output ---------------------------------------

4
processing/pre/seeds_check.sh
View File

@ -2,9 +2,9 @@
for seeds in "$@"
do
vtk_pointcloud $seeds
vtk_pointCloud $seeds
vtk_addPointcloudData $seeds \
vtk_addPointCloudData $seeds \
--data microstructure,weight \
--inplace \
--vtk ${seeds%.*}.vtp \

17
processing/pre/seeds_fromDistribution.py
View File

@ -1,10 +1,11 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import threading,time,os,sys,random
import numpy as np
from optparse import OptionParser
from cStringIO import StringIO
from io import StringIO
import binascii
import damask
scriptName = os.path.splitext(os.path.basename(__file__))[0]
@ -96,7 +97,7 @@ class myThread (threading.Thread):
perturbedGeomVFile = StringIO()
perturbedSeedsVFile.reset()
perturbedGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+
' -g '+' '.join(map(str, options.grid)),streamIn=perturbedSeedsVFile)[0])
' -g '+' '.join(list(map(str, options.grid))),streamIn=perturbedSeedsVFile)[0])
perturbedGeomVFile.reset()
#--- evaluate current seeds file ----------------------------------------------------------------------
@ -214,7 +215,7 @@ options = parser.parse_args()[0]
damask.util.report(scriptName,options.seedFile)
if options.randomSeed is None:
options.randomSeed = int(os.urandom(4).encode('hex'), 16)
options.randomSeed = int(binascii.hexlify(os.urandom(4)),16)
damask.util.croak(options.randomSeed)
delta = (options.scale/options.grid[0],options.scale/options.grid[1],options.scale/options.grid[2])
baseFile=os.path.splitext(os.path.basename(options.seedFile))[0]
@ -240,17 +241,17 @@ if os.path.isfile(os.path.splitext(options.seedFile)[0]+'.seeds'):
for line in initialSeedFile: bestSeedsVFile.write(line)
else:
bestSeedsVFile.write(damask.util.execute('seeds_fromRandom'+\
' -g '+' '.join(map(str, options.grid))+\
' -g '+' '.join(list(map(str, options.grid)))+\
' -r {:d}'.format(options.randomSeed)+\
' -N '+str(nMicrostructures))[0])
bestSeedsUpdate = time.time()
# ----------- tessellate initial seed file to get and evaluate geom file
bestSeedsVFile.reset()
bestSeedsVFile.seek(0)
initialGeomVFile = StringIO()
initialGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+
' -g '+' '.join(map(str, options.grid)),bestSeedsVFile)[0])
initialGeomVFile.reset()
' -g '+' '.join(list(map(str, options.grid))),bestSeedsVFile)[0])
initialGeomVFile.seek(0)
initialGeomTable = damask.ASCIItable(initialGeomVFile,None,labeled=False,readonly=True)
initialGeomTable.head_read()
info,devNull = initialGeomTable.head_getGeom()

2
processing/pre/seeds_fromRandom.py
View File

@ -28,7 +28,7 @@ def kdtree_search(cloud, queryPoints):
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options]', description = """
parser = OptionParser(option_class=damask.extendableOption, usage='%prog options', description = """
Distribute given number of points randomly within (a fraction of) the three-dimensional cube [0.0,0.0,0.0]--[1.0,1.0,1.0].
Reports positions with random crystal orientations in seeds file format to STDOUT.

13
python/damask/solver/abaqus.py
View File

@ -2,7 +2,7 @@
from .solver import Solver
import damask
import subprocess,re
import subprocess
class Abaqus(Solver):
@ -15,14 +15,13 @@ class Abaqus(Solver):
def return_run_command(self,model):
env=damask.Environment()
shortVersion = re.sub('[\.,-]', '',self.version)
try:
cmd='abq'+shortVersion
subprocess.check_output(['abq'+shortVersion,'information=release'])
cmd='abq'+self.version
subprocess.check_output([cmd,'information=release'])
except OSError: # link to abqXXX not existing
cmd='abaqus'
process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE)
detectedVersion = process.stdout.readlines()[1].split()[1]
detectedVersion = process.stdout.readlines()[1].split()[1].decode('utf-8')
if self.version != detectedVersion:
raise Exception('found Abaqus version %s, but requested %s'%(detectedVersion,self.version))
return '%s -job %s -user %s/src/DAMASK_abaqus interactive'%(cmd,model,env.rootDir())
raise Exception('found Abaqus version {}, but requested {}'.format(detectedVersion,self.version))
return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir())

37
src/CMakeLists.txt
View File

@ -7,6 +7,7 @@ endif()
# The dependency detection in CMake is not functioning for Fortran,
# hence we declare the dependencies from top to bottom in the following
add_library(C_ROUTINES OBJECT "C_routines.c")
set(OBJECTFILES $<TARGET_OBJECTS:C_ROUTINES>)
@ -17,6 +18,10 @@ list(APPEND OBJECTFILES $<TARGET_OBJECTS:SYSTEM_ROUTINES>)
add_library(PREC OBJECT "prec.f90")
list(APPEND OBJECTFILES $<TARGET_OBJECTS:PREC>)
add_library(ELEMENT OBJECT "element.f90")
add_dependencies(ELEMENT PREC)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:ELEMENT>)
add_library(QUIT OBJECT "quit.f90")
add_dependencies(QUIT PREC)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:QUIT>)
@ -34,7 +39,7 @@ add_dependencies(NUMERICS IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:NUMERICS>)
add_library(DEBUG OBJECT "debug.f90")
add_dependencies(DEBUG NUMERICS)
add_dependencies(DEBUG IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DEBUG>)
add_library(DAMASK_CONFIG OBJECT "config.f90")
@ -42,7 +47,7 @@ add_dependencies(DAMASK_CONFIG DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_CONFIG>)
add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90")
add_dependencies(HDF5_UTILITIES DAMASK_CONFIG)
add_dependencies(HDF5_UTILITIES DAMASK_CONFIG NUMERICS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:HDF5_UTILITIES>)
add_library(RESULTS OBJECT "results.f90")
@ -50,7 +55,7 @@ add_dependencies(RESULTS HDF5_UTILITIES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:RESULTS>)
add_library(FEsolving OBJECT "FEsolving.f90")
add_dependencies(FEsolving RESULTS)
add_dependencies(FEsolving DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEsolving>)
add_library(MATH OBJECT "math.f90")
@ -69,17 +74,21 @@ add_library(ROTATIONS OBJECT "rotations.f90")
add_dependencies(ROTATIONS LAMBERT QUATERNIONS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:ROTATIONS>)
add_library(MESH_BASE OBJECT "mesh_base.f90")
add_dependencies(MESH_BASE ELEMENT)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MESH_BASE>)
# SPECTRAL solver and FEM solver use different mesh files
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(MESH OBJECT "mesh.f90")
add_dependencies(MESH ROTATIONS FEsolving)
add_library(MESH OBJECT "mesh_grid.f90")
add_dependencies(MESH MESH_BASE MATH FEsolving)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MESH>)
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(FEZoo OBJECT "FEM_zoo.f90")
add_dependencies(FEZoo ROTATIONS FEsolving)
add_dependencies(FEZoo IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEZoo>)
add_library(MESH OBJECT "meshFEM.f90")
add_dependencies(MESH FEZoo)
add_library(MESH OBJECT "mesh_FEM.f90")
add_dependencies(MESH FEZoo MESH_BASE MATH FEsolving)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MESH>)
endif()
@ -87,9 +96,9 @@ add_library(MATERIAL OBJECT "material.f90")
add_dependencies(MATERIAL MESH DAMASK_CONFIG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MATERIAL>)
add_library(DAMASK_HELPERS OBJECT "lattice.f90")
add_dependencies(DAMASK_HELPERS MATERIAL)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_HELPERS>)
add_library(LATTICE OBJECT "lattice.f90")
add_dependencies(LATTICE MATERIAL)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:LATTICE>)
# For each modular section
add_library (PLASTIC OBJECT
@ -100,14 +109,14 @@ add_library (PLASTIC OBJECT
"plastic_kinematichardening.f90"
"plastic_nonlocal.f90"
"plastic_none.f90")
add_dependencies(PLASTIC DAMASK_HELPERS)
add_dependencies(PLASTIC LATTICE RESULTS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:PLASTIC>)
add_library (KINEMATICS OBJECT
"kinematics_cleavage_opening.f90"
"kinematics_slipplane_opening.f90"
"kinematics_thermal_expansion.f90")
add_dependencies(KINEMATICS DAMASK_HELPERS)
add_dependencies(KINEMATICS LATTICE RESULTS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:KINEMATICS>)
add_library (SOURCE OBJECT
@ -117,7 +126,7 @@ add_library (SOURCE OBJECT
"source_damage_isoDuctile.f90"
"source_damage_anisoBrittle.f90"
"source_damage_anisoDuctile.f90")
add_dependencies(SOURCE DAMASK_HELPERS)
add_dependencies(SOURCE LATTICE RESULTS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SOURCE>)
add_library(CONSTITUTIVE OBJECT "constitutive.f90")

15
src/CPFEM.f90
View File

@ -140,8 +140,7 @@ subroutine CPFEM_init
restartRead, &
modelName
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
theMesh
use material, only: &
material_phase, &
homogState, &
@ -168,10 +167,9 @@ subroutine CPFEM_init
flush(6)
endif mainProcess
! initialize stress and jacobian to zero
allocate(CPFEM_cs(6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_cs = 0.0_pReal
allocate(CPFEM_dcsdE(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE = 0.0_pReal
allocate(CPFEM_dcsdE_knownGood(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE_knownGood = 0.0_pReal
allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
! *** restore the last converged values of each essential variable from the binary file
if (restartRead) then
@ -289,8 +287,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
math_6toSym33
use mesh, only: &
mesh_FEasCP, &
mesh_NcpElems, &
mesh_maxNips, &
theMesh, &
mesh_element
use material, only: &
microstructure_elemhomo, &
@ -401,7 +398,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
enddo; enddo
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
write(6,'(a)') '<< CPFEM >> aging states'
if (debug_e <= mesh_NcpElems .and. debug_i <= mesh_maxNips) then
if (debug_e <= theMesh%Nelems .and. debug_i <= theMesh%elem%nIPs) then
write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') &
'<< CPFEM >> aged state of elFE ip grain',debug_e, debug_i, 1, &
plasticState(phaseAt(1,debug_i,debug_e))%state(:,phasememberAt(1,debug_i,debug_e))

2
src/CPFEM2.f90
View File

@ -95,8 +95,6 @@ subroutine CPFEM_init
use prec, only: &
pInt, pReal, pLongInt
use IO, only: &
IO_read_realFile,&
IO_read_intFile, &
IO_timeStamp, &
IO_error
use numerics, only: &

10
src/C_routines.c
View File

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

34
src/DAMASK_abaqus.f
View File

@ -30,6 +30,11 @@ contains
!> @brief reports and sets working directory
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
#if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use ifport, only: &
CHDIR
@ -40,16 +45,25 @@ subroutine DAMASK_interface_init
character(len=256) :: wd
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',&
dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
dateAndTime(6),':',&
dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(a,/)') ' Version: '//DAMASKVERSION
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with: ', compiler_version()
write(6,*) 'Compiler options: ', compiler_options()
#else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
call getoutdir(wd, lenOutDir)
ierr = CHDIR(wd)

81
src/DAMASK_interface.f90
View File

@ -12,9 +12,9 @@
module DAMASK_interface
use prec, only: &
pInt
implicit none
private
logical, public, protected :: SIGUSR1,SIGUSR2
integer(pInt), public, protected :: &
interface_restartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: &
@ -42,6 +42,8 @@ contains
subroutine DAMASK_interface_init()
use, intrinsic :: &
iso_fortran_env
use :: &
iso_c_binding
#include <petsc/finclude/petscsys.h>
#if defined(__GFORTRAN__) && __GNUC__ < 5
===================================================================================================
@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
use PETScSys
use system_routines, only: &
signalusr1_C, &
signalusr2_C, &
getHostName, &
getCWD
@ -139,16 +143,27 @@ subroutine DAMASK_interface_init()
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',&
dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
dateAndTime(6),':',&
dateAndTime(7)
write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize
#include "compilation_info.f90"
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(a,/)') ' Version: '//DAMASKVERSION
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with: ', compiler_version()
write(6,*) 'Compiler options: ', compiler_options()
#elif defined(__INTEL_COMPILER)
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
#elif defined(__PGI)
write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version :', __PGIC__,&
'.', __PGIC_MINOR__
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
call get_command(commandLine)
chunkPos = IIO_stringPos(commandLine)
@ -215,9 +230,11 @@ subroutine DAMASK_interface_init()
call get_environment_variable('USER',userName)
! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux
write(6,'(a,a)') ' Host name: ', trim(getHostName())
write(6,'(a,a)') ' User name: ', trim(userName)
write(6,'(a,a)') ' Command line call: ', trim(commandLine)
write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize
write(6,'(a,a)') ' Host name: ', trim(getHostName())
write(6,'(a,a)') ' User name: ', trim(userName)
write(6,'(/a,a)') ' Command line call: ', trim(commandLine)
if (len(trim(workingDirArg)) > 0) &
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg)
@ -229,6 +246,12 @@ subroutine DAMASK_interface_init()
if (interface_restartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
call signalusr1_c(c_funloc(setSIGUSR1))
call signalusr2_c(c_funloc(setSIGUSR2))
SIGUSR1 = .false.
SIGUSR2 = .false.
end subroutine DAMASK_interface_init
@ -412,6 +435,35 @@ character(len=1024) function makeRelativePath(a,b)
end function makeRelativePath
!--------------------------------------------------------------------------------------------------
!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1
!--------------------------------------------------------------------------------------------------
subroutine setSIGUSR1(signal) bind(C)
use :: iso_c_binding
implicit none
integer(C_INT), value :: signal
SIGUSR1 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR1'
end subroutine setSIGUSR1
!--------------------------------------------------------------------------------------------------
!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2
!--------------------------------------------------------------------------------------------------
subroutine setSIGUSR2(signal) bind(C)
use :: iso_c_binding
implicit none
integer(C_INT), value :: signal
SIGUSR2 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR2'
end subroutine setSIGUSR2
!--------------------------------------------------------------------------------------------------
!> @brief taken from IO, check IO_stringValue for documentation
@ -469,7 +521,6 @@ pure function IIO_stringPos(string)
do while (verify(string(right+1:),SEP)>0)
left = right + verify(string(right+1:),SEP)
right = left + scan(string(left:),SEP) - 2
if ( string(left:left) == '#' ) exit
IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
enddo

42
src/DAMASK_marc.f90
View File

@ -43,6 +43,11 @@ contains
!> @brief reports and sets working directory
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
#if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use ifport, only: &
CHDIR
@ -53,17 +58,26 @@ subroutine DAMASK_interface_init
character(len=1024) :: wd
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',&
dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
dateAndTime(6),':',&
dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
#include "compilation_info.f90"
write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(a,/)') ' Version: '//DAMASKVERSION
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with: ', compiler_version()
write(6,*) 'Compiler options: ', compiler_options()
#else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
inquire(5, name=wd) ! determine inputputfile
wd = wd(1:scan(wd,'/',back=.true.))
ierr = CHDIR(wd)
@ -134,6 +148,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
debug_info, &
debug_reset
use mesh, only: &
theMesh, &
mesh_FEasCP, &
mesh_element, &
mesh_node0, &
@ -141,8 +156,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
mesh_Ncellnodes, &
mesh_cellnode, &
mesh_build_cellnodes, &
mesh_build_ipCoordinates, &
FE_Nnodes
mesh_build_ipCoordinates
use CPFEM, only: &
CPFEM_general, &
CPFEM_init_done, &
@ -314,7 +328,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence
lastIncConverged = .false. ! reset flag
endif
do node = 1,FE_Nnodes(mesh_element(2,cp_en))
do node = 1,theMesh%elem%nNodes
CPnodeID = mesh_element(4_pInt+node,cp_en)
mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
enddo

9
src/FEM_utilities.f90
View File

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

4
src/FEM_zoo.f90
View File

@ -9,11 +9,11 @@ module FEM_Zoo
private
integer(pInt), parameter, public:: &
maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary)
real(pReal), dimension(2,3), private, protected :: &
real(pReal), dimension(2,3), private, parameter :: &
triangle = reshape([-1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, &
-1.0_pReal, 1.0_pReal], shape=[2,3])
real(pReal), dimension(3,4), private, protected :: &
real(pReal), dimension(3,4), private, parameter :: &
tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, -1.0_pReal, &
-1.0_pReal, 1.0_pReal, -1.0_pReal, &

2759
src/HDF5_utilities.f90
View File

File diff suppressed because it is too large Load Diff

888
src/IO.f90
View File

File diff suppressed because it is too large Load Diff

9
src/commercialFEM_fileList.f90
View File

@ -15,7 +15,14 @@
#include "Lambert.f90"
#include "rotations.f90"
#include "FEsolving.f90"
#include "mesh.f90"
#include "element.f90"
#include "mesh_base.f90"
#ifdef Abaqus
#include "mesh_abaqus.f90"
#endif
#ifdef Marc4DAMASK
#include "mesh_marc.f90"
#endif
#include "material.f90"
#include "lattice.f90"
#include "source_thermal_dissipation.f90"

10
src/compilation_info.f90
View File

@ -1,10 +0,0 @@
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with ', compiler_version()
write(6,*) 'With options ', compiler_options()
#else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,&
', build date ', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,*)
flush(6)

45
src/constitutive.f90
View File

@ -56,12 +56,9 @@ subroutine constitutive_init()
IO_checkAndRewind, &
IO_open_jobFile_stat, &
IO_write_jobFile, &
IO_write_jobIntFile, &
IO_timeStamp
use config, only: &
config_phase
use mesh, only: &
FE_geomtype
use config, only: &
material_Nphase, &
material_localFileExt, &
@ -163,16 +160,16 @@ subroutine constitutive_init()
call IO_checkAndRewind(FILEUNIT)
if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init(FILEUNIT)
if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT)
if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init(FILEUNIT)
if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init(FILEUNIT)
if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(FILEUNIT)
if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(FILEUNIT)
if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init
if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init
if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init
if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init
!--------------------------------------------------------------------------------------------------
! parse kinematic mechanisms from config file
call IO_checkAndRewind(FILEUNIT)
if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init(FILEUNIT)
if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init(FILEUNIT)
if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init
if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init
if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(FILEUNIT)
close(FILEUNIT)
@ -609,9 +606,9 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
KinematicsLoop: do k = 1_pInt, phase_Nkinematics(material_phase(ipc,ip,el))
kinematicsType: select case (phase_kinematics(k,material_phase(ipc,ip,el)))
case (KINEMATICS_cleavage_opening_ID) kinematicsType
call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el)
call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el)
case (KINEMATICS_slipplane_opening_ID) kinematicsType
call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el)
call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el)
case (KINEMATICS_thermal_expansion_ID) kinematicsType
call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el)
case default kinematicsType
@ -788,8 +785,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
math_sym33to6, &
math_mul33x33
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
theMesh
use material, only: &
phasememberAt, &
phase_plasticityInstance, &
@ -840,9 +836,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
el !< element
real(pReal), intent(in) :: &
subdt !< timestep
real(pReal), intent(in), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
real(pReal), intent(in), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
subfracArray !< subfraction of timestep
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
FeArray, & !< elastic deformation gradient
FpArray !< plastic deformation gradient
real(pReal), intent(in), dimension(3,3) :: &
@ -899,7 +895,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
sourceType: select case (phase_source(s,material_phase(ipc,ip,el)))
case (SOURCE_damage_anisoBrittle_ID) sourceType
call source_damage_anisoBrittle_dotState (S6, ipc, ip, el) !< correct stress?
call source_damage_anisoBrittle_dotState (math_6toSym33(S6), ipc, ip, el) !< correct stress?
case (SOURCE_damage_isoDuctile_ID) sourceType
call source_damage_isoDuctile_dotState ( ipc, ip, el)
@ -1002,8 +998,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
math_6toSym33, &
math_mul33x33
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
theMesh
use material, only: &
phasememberAt, &
phase_plasticityInstance, &
@ -1059,7 +1054,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
constitutive_postResults
real(pReal), intent(in), dimension(3,3) :: &
Fi !< intermediate deformation gradient
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
FeArray !< elastic deformation gradient
real(pReal), intent(in), dimension(6) :: &
S6 !< 2nd Piola Kirchhoff stress (vector notation)
@ -1121,16 +1116,18 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
SourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el))
startPos = endPos + 1_pInt
endPos = endPos + sourceState(material_phase(ipc,ip,el))%p(s)%sizePostResults
of = phasememberAt(ipc,ip,el)
sourceType: select case (phase_source(s,material_phase(ipc,ip,el)))
case (SOURCE_damage_isoBrittle_ID) sourceType
constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(ipc, ip, el)
constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phase(ipc,ip,el),of)
case (SOURCE_damage_isoDuctile_ID) sourceType
constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(ipc, ip, el)
constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(material_phase(ipc,ip,el),of)
case (SOURCE_damage_anisoBrittle_ID) sourceType
constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(ipc, ip, el)
constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(material_phase(ipc,ip,el),of)
case (SOURCE_damage_anisoDuctile_ID) sourceType
constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(ipc, ip, el)
constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(material_phase(ipc,ip,el),of)
end select sourceType
enddo SourceLoop
end function constitutive_postResults

81
src/crystallite.f90
View File

@ -17,8 +17,6 @@ module crystallite
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP
use mesh, only: &
mesh_element
use material, only: &
homogenization_Ngrains
@ -157,10 +155,8 @@ subroutine crystallite_init
math_inv33, &
math_mul33x33
use mesh, only: &
mesh_element, &
mesh_NcpElems, &
mesh_maxNips, &
mesh_maxNipNeighbors
theMesh, &
mesh_element
use IO, only: &
IO_timeStamp, &
IO_stringValue, &
@ -198,8 +194,8 @@ subroutine crystallite_init
#include "compilation_info.f90"
cMax = homogenization_maxNgrains
iMax = mesh_maxNips
eMax = mesh_NcpElems
iMax = theMesh%elem%nIPs
eMax = theMesh%nElems
! ---------------------------------------------------------------------------
! ToDo (when working on homogenization): should be 3x3 tensor called S
@ -330,7 +326,7 @@ subroutine crystallite_init
case(elasmatrix_ID)
mySize = 36_pInt
case(neighboringip_ID,neighboringelement_ID)
mySize = mesh_maxNipNeighbors
mySize = theMesh%elem%nIPneighbors
case default
mySize = 0_pInt
end select
@ -411,7 +407,7 @@ subroutine crystallite_init
write(6,'(a42,1x,i10)') ' # of elements: ', eMax
write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax
write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax
write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', mesh_maxNipNeighbors
write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', theMesh%elem%nIPneighbors
write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity)
flush(6)
endif
@ -426,7 +422,7 @@ end subroutine crystallite_init
!--------------------------------------------------------------------------------------------------
!> @brief calculate stress (P)
!--------------------------------------------------------------------------------------------------
function crystallite_stress()
function crystallite_stress(a)
use prec, only: &
tol_math_check, &
dNeq0
@ -454,10 +450,8 @@ function crystallite_stress()
math_6toSym33, &
math_sym33to6
use mesh, only: &
mesh_NcpElems, &
mesh_element, &
mesh_maxNips, &
FE_geomtype
theMesh, &
mesh_element
use material, only: &
homogenization_Ngrains, &
plasticState, &
@ -470,7 +464,8 @@ function crystallite_stress()
constitutive_LiAndItsTangents
implicit none
logical, dimension(mesh_maxNips,mesh_NcpElems) :: crystallite_stress
logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress
real(pReal), intent(in), optional :: a !ToDo: for some reason this prevents an internal compiler error in GNU. Very strange
real(pReal) :: &
formerSubStep
integer(pInt) :: &
@ -537,7 +532,7 @@ function crystallite_stress()
endIP = startIP
else singleRun
startIP = 1_pInt
endIP = mesh_maxNips
endIP = theMesh%elem%nIPs
endif singleRun
NiterationCrystallite = 0_pInt
@ -723,8 +718,7 @@ subroutine crystallite_stressTangent()
math_invert2, &
math_det33
use mesh, only: &
mesh_element, &
FE_geomtype
mesh_element
use material, only: &
homogenization_Ngrains
use constitutive, only: &
@ -923,7 +917,7 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33)
math_inv33, &
math_EulerToR
use material, only: &
material_EulerAngles
material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0
implicit none
real(pReal), dimension(3,3) :: crystallite_push33ToRef
@ -954,13 +948,10 @@ function crystallite_postResults(ipc, ip, el)
inDeg, &
math_6toSym33
use mesh, only: &
theMesh, &
mesh_element, &
mesh_ipVolume, &
mesh_maxNipNeighbors, &
mesh_ipNeighborhood, &
FE_NipNeighbors, &
FE_geomtype, &
FE_celltype
mesh_ipNeighborhood
use material, only: &
plasticState, &
sourceState, &
@ -1064,14 +1055,14 @@ function crystallite_postResults(ipc, ip, el)
mySize = 36_pInt
crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize])
case(neighboringelement_ID)
mySize = mesh_maxNipNeighbors
mySize = theMesh%elem%nIPneighbors
crystallite_postResults(c+1:c+mySize) = 0.0_pReal
forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) &
forall (n = 1_pInt:mySize) &
crystallite_postResults(c+n) = real(mesh_ipNeighborhood(1,n,ip,el),pReal)
case(neighboringip_ID)
mySize = mesh_maxNipNeighbors
mySize = theMesh%elem%nIPneighbors
crystallite_postResults(c+1:c+mySize) = 0.0_pReal
forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) &
forall (n = 1_pInt:mySize) &
crystallite_postResults(c+n) = real(mesh_ipNeighborhood(2,n,ip,el),pReal)
end select
c = c + mySize
@ -1748,9 +1739,8 @@ end subroutine integrateStateEuler
!--------------------------------------------------------------------------------------------------
subroutine integrateStateAdaptiveEuler()
use mesh, only: &
mesh_element, &
mesh_NcpElems, &
mesh_maxNips
theMesh, &
mesh_element
use material, only: &
homogenization_Ngrains, &
plasticState, &
@ -1774,11 +1764,11 @@ subroutine integrateStateAdaptiveEuler()
! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler
real(pReal), dimension(constitutive_plasticity_maxSizeDotState, &
homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
residuum_plastic
real(pReal), dimension(constitutive_source_maxSizeDotState,&
maxval(phase_Nsources), &
homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
residuum_source
!--------------------------------------------------------------------------------------------------
@ -1925,8 +1915,7 @@ end subroutine integrateStateRK4
subroutine integrateStateRKCK45()
use mesh, only: &
mesh_element, &
mesh_NcpElems, &
mesh_maxNips
theMesh
use material, only: &
homogenization_Ngrains, &
plasticState, &
@ -1973,11 +1962,11 @@ subroutine integrateStateRKCK45()
! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45
real(pReal), dimension(constitutive_plasticity_maxSizeDotState, &
homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
residuum_plastic ! relative residuum from evolution in microstructure
real(pReal), dimension(constitutive_source_maxSizeDotState, &
maxval(phase_Nsources), &
homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
residuum_source ! relative residuum from evolution in microstructure
@ -2122,7 +2111,8 @@ end subroutine nonlocalConvergenceCheck
!> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria
!--------------------------------------------------------------------------------------------------
subroutine setConvergenceFlag()
use mesh, only: &
mesh_element
implicit none
integer(pInt) :: &
e, & !< element index in element loop
@ -2162,7 +2152,8 @@ end subroutine setConvergenceFlag
!> @brief Standard forwarding of state as state = state0 + dotState * (delta t)
!--------------------------------------------------------------------------------------------------
subroutine update_stress(timeFraction)
use mesh, only: &
mesh_element
implicit none
real(pReal), intent(in) :: &
timeFraction
@ -2194,6 +2185,8 @@ end subroutine update_stress
!> @brief tbd
!--------------------------------------------------------------------------------------------------
subroutine update_dependentState()
use mesh, only: &
mesh_element
use constitutive, only: &
constitutive_dependentState => constitutive_microstructure
@ -2225,6 +2218,8 @@ subroutine update_state(timeFraction)
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt
use mesh, only: &
mesh_element
implicit none
real(pReal), intent(in) :: &
@ -2274,6 +2269,8 @@ subroutine update_dotState(timeFraction)
sourceState, &
phaseAt, phasememberAt, &
phase_Nsources
use mesh, only: &
mesh_element
use constitutive, only: &
constitutive_collectDotState
@ -2327,6 +2324,8 @@ subroutine update_deltaState
IEEE_arithmetic
use prec, only: &
dNeq0
use mesh, only: &
mesh_element
use material, only: &
plasticState, &
sourceState, &
@ -2422,6 +2421,8 @@ logical function stateJump(ipc,ip,el)
sourceState, &
phase_Nsources, &
phaseAt, phasememberAt
use mesh, only: &
mesh_element
use constitutive, only: &
constitutive_collectDeltaState
use math, only: &

13
src/damage_local.f90
View File

@ -225,6 +225,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
homogenization_Ngrains, &
mappingHomogenization, &
phaseAt, &
phasememberAt, &
phase_source, &
phase_Nsources, &
SOURCE_damage_isoBrittle_ID, &
@ -249,7 +250,8 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
integer(pInt) :: &
phase, &
grain, &
source
source, &
constituent
real(pReal) :: &
phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi
@ -257,19 +259,20 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
dPhiDot_dPhi = 0.0_pReal
do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
phase = phaseAt(grain,ip,el)
constituent = phasememberAt(grain,ip,el)
do source = 1, phase_Nsources(phase)
select case(phase_source(source,phase))
case (SOURCE_damage_isoBrittle_ID)
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_isoDuctile_ID)
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoBrittle_ID)
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoDuctile_ID)
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case default
localphiDot = 0.0_pReal

13
src/damage_nonlocal.f90
View File

@ -186,6 +186,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
homogenization_Ngrains, &
mappingHomogenization, &
phaseAt, &
phasememberAt, &
phase_source, &
phase_Nsources, &
SOURCE_damage_isoBrittle_ID, &
@ -210,7 +211,8 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
integer(pInt) :: &
phase, &
grain, &
source
source, &
constituent
real(pReal) :: &
phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi
@ -218,19 +220,20 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
dPhiDot_dPhi = 0.0_pReal
do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
phase = phaseAt(grain,ip,el)
constituent = phasememberAt(grain,ip,el)
do source = 1_pInt, phase_Nsources(phase)
select case(phase_source(source,phase))
case (SOURCE_damage_isoBrittle_ID)
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_isoDuctile_ID)
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoBrittle_ID)
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoDuctile_ID)
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el)
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case default
localphiDot = 0.0_pReal

921
src/element.f90 Normal file
View File

@ -0,0 +1,921 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH
!--------------------------------------------------------------------------------------------------
module element
use prec, only: &
pInt, &
pReal
implicit none
private
!---------------------------------------------------------------------------------------------------
!> Properties of a single element (the element used in the mesh)
!---------------------------------------------------------------------------------------------------
type, public :: tElement
integer(pInt) :: &
elemType, &
geomType, & ! geometry type (same for same dimension and same number of integration points)
cellType, &
Nnodes, &
Ncellnodes, &
NcellnodesPerCell, &
nIPs, &
nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors?
maxNnodeAtIP
integer(pInt), dimension(:,:), allocatable :: &
Cell, & ! intra-element (cell) nodes that constitute a cell
NnodeAtIP, &
IPneighbor, &
cellFace
real(pReal), dimension(:,:), allocatable :: &
! center of gravity of the weighted nodes gives the position of the cell node.
! example: face-centered cell node with face nodes 1,2,5,6 to be used in,
! e.g., an 8 node element, would be encoded:
! 1, 1, 0, 0, 1, 1, 0, 0
cellNodeParentNodeWeights
contains
procedure :: init => tElement_init
end type
integer(pInt), parameter, private :: &
NELEMTYPE = 13_pInt
integer(pInt), dimension(NelemType), parameter, private :: NNODE = &
int([ &
3, & ! 2D 3node 1ip
6, & ! 2D 6node 3ip
4, & ! 2D 4node 4ip
8, & ! 2D 8node 9ip
8, & ! 2D 8node 4ip
!--------------------
4, & ! 3D 4node 1ip
5, & ! 3D 5node 4ip
10, & ! 3D 10node 4ip
6, & ! 3D 6node 6ip
8, & ! 3D 8node 1ip
8, & ! 3D 8node 8ip
20, & ! 3D 20node 8ip
20 & ! 3D 20node 27ip
],pInt) !< number of nodes that constitute a specific type of element
integer(pInt), dimension(NelemType), parameter, public :: GEOMTYPE = &
int([ &
1, & ! 2D 3node 1ip
2, & ! 2D 6node 3ip
3, & ! 2D 4node 4ip
4, & ! 2D 8node 9ip
3, & ! 2D 8node 4ip
!--------------------
5, & ! 3D 4node 1ip
6, & ! 3D 5node 4ip
6, & ! 3D 10node 4ip
7, & ! 3D 6node 6ip
8, & ! 3D 8node 1ip
9, & ! 3D 8node 8ip
9, & ! 3D 20node 8ip
10 & ! 3D 20node 27ip
],pInt) !< geometry type of particular element type
!integer(pInt), dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains
integer(pInt), dimension(10), parameter, private :: NCELLNODE = &
int([ &
3, &
7, &
9, &
16, &
4, &
15, &
21, &
8, &
27, &
64 &
],pInt) !< number of cell nodes in a specific geometry type
!integer(pInt), dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains
integer(pInt), dimension(10), parameter, private :: NIP = &
int([ &
1, &
3, &
4, &
9, &
1, &
4, &
6, &
1, &
8, &
27 &
],pInt) !< number of IPs in a specific geometry type
!integer(pInt), dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains
integer(pInt), dimension(10), parameter, private :: CELLTYPE = & !< cell type that is used by each geometry type
int([ &
1, & ! 2D 3node
2, & ! 2D 4node
2, & ! 2D 4node
2, & ! 2D 4node
3, & ! 3D 4node
4, & ! 3D 8node
4, & ! 3D 8node
4, & ! 3D 8node
4, & ! 3D 8node
4 & ! 3D 8node
],pInt)
!integer(pInt), dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! causes problem with Intel 16.0
integer(pInt), dimension(4), parameter, private :: NIPNEIGHBOR = & !< number of ip neighbors / cell faces in a specific cell type
int([&
3, & ! 2D 3node
4, & ! 2D 4node
4, & ! 3D 4node
6 & ! 3D 8node
],pInt)
!integer(pInt), dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = &
integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & !< number of cell nodes in a specific cell type
int([ &
2, & ! 2D 3node
2, & ! 2D 4node
3, & ! 3D 4node
4 & ! 3D 8node
],pInt)
!integer(pInt), dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! causes problem with Intel 16.0
integer(pInt), dimension(10), parameter, private :: maxNnodeAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element
int([ &
3, &
1, &
1, &
2, &
4, &
1, &
1, &
8, &
1, &
4 &
],pInt)
!integer(pInt), dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains
integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELL = & !< number of cell nodes in a specific cell type
int([ &
3, & ! 2D 3node
4, & ! 2D 4node
4, & ! 3D 4node
8 & ! 3D 8node
],pInt)
integer(pInt), dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = &
reshape(int([&
1,2,3 &
],pInt),[maxNnodeAtIP(1),nIP(1)])
integer(pInt), dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = &
reshape(int([&
1, &
2, &
3 &
],pInt),[maxNnodeAtIP(2),nIP(2)])
integer(pInt), dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = &
reshape(int([&
1, &
2, &
4, &
3 &
],pInt),[maxNnodeAtIP(3),nIP(3)])
integer(pInt), dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = &
reshape(int([&
1,0, &
1,2, &
2,0, &
1,4, &
0,0, &
2,3, &
4,0, &
3,4, &
3,0 &
],pInt),[maxNnodeAtIP(4),nIP(4)])
integer(pInt), dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = &
reshape(int([&
1,2,3,4 &
],pInt),[maxNnodeAtIP(5),nIP(5)])
integer(pInt), dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = &
reshape(int([&
1, &
2, &
3, &
4 &
],pInt),[maxNnodeAtIP(6),nIP(6)])
integer(pInt), dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = &
reshape(int([&
1, &
2, &
3, &
4, &
5, &
6 &
],pInt),[maxNnodeAtIP(7),nIP(7)])
integer(pInt), dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = &
reshape(int([&
1,2,3,4,5,6,7,8 &
],pInt),[maxNnodeAtIP(8),nIP(8)])
integer(pInt), dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = &
reshape(int([&
1, &
2, &
4, &
3, &
5, &
6, &
8, &
7 &
],pInt),[maxNnodeAtIP(9),nIP(9)])
integer(pInt), dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = &
reshape(int([&
1,0, 0,0, &
1,2, 0,0, &
2,0, 0,0, &
1,4, 0,0, &
1,3, 2,4, &
2,3, 0,0, &
4,0, 0,0, &
3,4, 0,0, &
3,0, 0,0, &
1,5, 0,0, &
1,6, 2,5, &
2,6, 0,0, &
1,8, 4,5, &
0,0, 0,0, &
2,7, 3,6, &
4,8, 0,0, &
3,8, 4,7, &
3,7, 0,0, &
5,0, 0,0, &
5,6, 0,0, &
6,0, 0,0, &
5,8, 0,0, &
5,7, 6,8, &
6,7, 0,0, &
8,0, 0,0, &
7,8, 0,0, &
7,0, 0,0 &
],pInt),[maxNnodeAtIP(10),nIP(10)])
! *** FE_ipNeighbor ***
! is a list of the neighborhood of each IP.
! It is sorted in (local) +x,-x, +y,-y, +z,-z direction.
! Positive integers denote an intra-FE IP identifier.
! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located.
integer(pInt), dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = &
reshape(int([&
-2,-3,-1 &
],pInt),[nIPneighbor(cellType(1)),nIP(1)])
integer(pInt), dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = &
reshape(int([&
2,-3, 3,-1, &
-2, 1, 3,-1, &
2,-3,-2, 1 &
],pInt),[nIPneighbor(cellType(2)),nIP(2)])
integer(pInt), dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = &
reshape(int([&
2,-4, 3,-1, &
-2, 1, 4,-1, &
4,-4,-3, 1, &
-2, 3,-3, 2 &
],pInt),[nIPneighbor(cellType(3)),nIP(3)])
integer(pInt), dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = &
reshape(int([&
2,-4, 4,-1, &
3, 1, 5,-1, &
-2, 2, 6,-1, &
5,-4, 7, 1, &
6, 4, 8, 2, &
-2, 5, 9, 3, &
8,-4,-3, 4, &
9, 7,-3, 5, &
-2, 8,-3, 6 &
],pInt),[nIPneighbor(cellType(4)),nIP(4)])
integer(pInt), dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = &
reshape(int([&
-1,-2,-3,-4 &
],pInt),[nIPneighbor(cellType(5)),nIP(5)])
integer(pInt), dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = &
reshape(int([&
2,-4, 3,-2, 4,-1, &
-2, 1, 3,-2, 4,-1, &
2,-4,-3, 1, 4,-1, &
2,-4, 3,-2,-3, 1 &
],pInt),[nIPneighbor(cellType(6)),nIP(6)])
integer(pInt), dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = &
reshape(int([&
2,-4, 3,-2, 4,-1, &
-3, 1, 3,-2, 5,-1, &
2,-4,-3, 1, 6,-1, &
5,-4, 6,-2,-5, 1, &
-3, 4, 6,-2,-5, 2, &
5,-4,-3, 4,-5, 3 &
],pInt),[nIPneighbor(cellType(7)),nIP(7)])
integer(pInt), dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = &
reshape(int([&
-3,-5,-4,-2,-6,-1 &
],pInt),[nIPneighbor(cellType(8)),nIP(8)])
integer(pInt), dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = &
reshape(int([&
2,-5, 3,-2, 5,-1, &
-3, 1, 4,-2, 6,-1, &
4,-5,-4, 1, 7,-1, &
-3, 3,-4, 2, 8,-1, &
6,-5, 7,-2,-6, 1, &
-3, 5, 8,-2,-6, 2, &
8,-5,-4, 5,-6, 3, &
-3, 7,-4, 6,-6, 4 &
],pInt),[nIPneighbor(cellType(9)),nIP(9)])
integer(pInt), dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = &
reshape(int([&
2,-5, 4,-2,10,-1, &
3, 1, 5,-2,11,-1, &
-3, 2, 6,-2,12,-1, &
5,-5, 7, 1,13,-1, &
6, 4, 8, 2,14,-1, &
-3, 5, 9, 3,15,-1, &
8,-5,-4, 4,16,-1, &
9, 7,-4, 5,17,-1, &
-3, 8,-4, 6,18,-1, &
11,-5,13,-2,19, 1, &
12,10,14,-2,20, 2, &
-3,11,15,-2,21, 3, &
14,-5,16,10,22, 4, &
15,13,17,11,23, 5, &
-3,14,18,12,24, 6, &
17,-5,-4,13,25, 7, &
18,16,-4,14,26, 8, &
-3,17,-4,15,27, 9, &
20,-5,22,-2,-6,10, &
21,19,23,-2,-6,11, &
-3,20,24,-2,-6,12, &
23,-5,25,19,-6,13, &
24,22,26,20,-6,14, &
-3,23,27,21,-6,15, &
26,-5,-4,22,-6,16, &
27,25,-4,23,-6,17, &
-3,26,-4,24,-6,18 &
],pInt),[nIPneighbor(cellType(10)),nIP(10)])
real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = &
reshape(real([&
1, 0, 0, &
0, 1, 0, &
0, 0, 1 &
],pReal),[nNode(1),NcellNode(geomType(1))]) ! 2D 3node 1ip
real(pReal), dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = &
reshape(real([&
1, 0, 0, 0, 0, 0, &
0, 1, 0, 0, 0, 0, &
0, 0, 1, 0, 0, 0, &
0, 0, 0, 1, 0, 0, &
0, 0, 0, 0, 1, 0, &
0, 0, 0, 0, 0, 1, &
1, 1, 1, 2, 2, 2 &
],pReal),[nNode(2),NcellNode(geomType(2))]) ! 2D 6node 3ip
real(pReal), dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = &
reshape(real([&
1, 0, 0, 0, &
0, 1, 0, 0, &
0, 0, 1, 0, &
0, 0, 0, 1, &
1, 1, 0, 0, &
0, 1, 1, 0, &
0, 0, 1, 1, &
1, 0, 0, 1, &
1, 1, 1, 1 &
],pReal),[nNode(3),NcellNode(geomType(3))]) ! 2D 6node 3ip
real(pReal), dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = &
reshape(real([&
1, 0, 0, 0, 0, 0, 0, 0, &
0, 1, 0, 0, 0, 0, 0, 0, &
0, 0, 1, 0, 0, 0, 0, 0, &
0, 0, 0, 1, 0, 0, 0, 0, &
1, 0, 0, 0, 2, 0, 0, 0, &
0, 1, 0, 0, 2, 0, 0, 0, &
0, 1, 0, 0, 0, 2, 0, 0, &
0, 0, 1, 0, 0, 2, 0, 0, &
0, 0, 1, 0, 0, 0, 2, 0, &
0, 0, 0, 1, 0, 0, 2, 0, &
0, 0, 0, 1, 0, 0, 0, 2, &
1, 0, 0, 0, 0, 0, 0, 2, &
4, 1, 1, 1, 8, 2, 2, 8, &
1, 4, 1, 1, 8, 8, 2, 2, &
1, 1, 4, 1, 2, 8, 8, 2, &
1, 1, 1, 4, 2, 2, 8, 8 &
],pReal),[nNode(4),NcellNode(geomType(4))]) ! 2D 8node 9ip
real(pReal), dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = &
reshape(real([&
1, 0, 0, 0, 0, 0, 0, 0, &
0, 1, 0, 0, 0, 0, 0, 0, &
0, 0, 1, 0, 0, 0, 0, 0, &
0, 0, 0, 1, 0, 0, 0, 0, &
0, 0, 0, 0, 1, 0, 0, 0, &
0, 0, 0, 0, 0, 1, 0, 0, &
0, 0, 0, 0, 0, 0, 1, 0, &
0, 0, 0, 0, 0, 0, 0, 1, &
1, 1, 1, 1, 2, 2, 2, 2 &
],pReal),[nNode(5),NcellNode(geomType(5))]) ! 2D 8node 4ip
real(pReal), dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = &
reshape(real([&
1, 0, 0, 0, &
0, 1, 0, 0, &
0, 0, 1, 0, &
0, 0, 0, 1 &
],pReal),[nNode(6),NcellNode(geomType(6))]) ! 3D 4node 1ip
real(pReal), dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = &
reshape(real([&
1, 0, 0, 0, 0, &
0, 1, 0, 0, 0, &
0, 0, 1, 0, 0, &
0, 0, 0, 1, 0, &
1, 1, 0, 0, 0, &
0, 1, 1, 0, 0, &
1, 0, 1, 0, 0, &
1, 0, 0, 1, 0, &
0, 1, 0, 1, 0, &
0, 0, 1, 1, 0, &
1, 1, 1, 0, 0, &
1, 1, 0, 1, 0, &
0, 1, 1, 1, 0, &
1, 0, 1, 1, 0, &
0, 0, 0, 0, 1 &
],pReal),[nNode(7),NcellNode(geomType(7))]) ! 3D 5node 4ip
real(pReal), dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = &
reshape(real([&
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, &
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, &
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, &
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, &
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, &
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, &
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, &
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, &
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, &
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, &
1, 1, 1, 0, 2, 2, 2, 0, 0, 0, &
1, 1, 0, 1, 2, 0, 0, 2, 2, 0, &
0, 1, 1, 1, 0, 2, 0, 0, 2, 2, &
1, 0, 1, 1, 0, 0, 2, 2, 0, 2, &
3, 3, 3, 3, 4, 4, 4, 4, 4, 4 &
],pReal),[nNode(8),NcellNode(geomType(8))]) ! 3D 10node 4ip
real(pReal), dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = &
reshape(real([&
1, 0, 0, 0, 0, 0, &
0, 1, 0, 0, 0, 0, &
0, 0, 1, 0, 0, 0, &
0, 0, 0, 1, 0, 0, &
0, 0, 0, 0, 1, 0, &
0, 0, 0, 0, 0, 1, &
1, 1, 0, 0, 0, 0, &
0, 1, 1, 0, 0, 0, &
1, 0, 1, 0, 0, 0, &
1, 0, 0, 1, 0, 0, &
0, 1, 0, 0, 1, 0, &
0, 0, 1, 0, 0, 1, &
0, 0, 0, 1, 1, 0, &
0, 0, 0, 0, 1, 1, &
0, 0, 0, 1, 0, 1, &
1, 1, 1, 0, 0, 0, &
1, 1, 0, 1, 1, 0, &
0, 1, 1, 0, 1, 1, &
1, 0, 1, 1, 0, 1, &
0, 0, 0, 1, 1, 1, &
1, 1, 1, 1, 1, 1 &
],pReal),[nNode(9),NcellNode(geomType(9))]) ! 3D 6node 6ip
real(pReal), dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = &
reshape(real([&
1, 0, 0, 0, 0, 0, 0, 0, &
0, 1, 0, 0, 0, 0, 0, 0, &
0, 0, 1, 0, 0, 0, 0, 0, &
0, 0, 0, 1, 0, 0, 0, 0, &
0, 0, 0, 0, 1, 0, 0, 0, &
0, 0, 0, 0, 0, 1, 0, 0, &
0, 0, 0, 0, 0, 0, 1, 0, &
0, 0, 0, 0, 0, 0, 0, 1 &
],pReal),[nNode(10),NcellNode(geomType(10))]) ! 3D 8node 1ip
real(pReal), dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = &
reshape(real([&
1, 0, 0, 0, 0, 0, 0, 0, & !
0, 1, 0, 0, 0, 0, 0, 0, & !
0, 0, 1, 0, 0, 0, 0, 0, & !
0, 0, 0, 1, 0, 0, 0, 0, & !
0, 0, 0, 0, 1, 0, 0, 0, & ! 5
0, 0, 0, 0, 0, 1, 0, 0, & !
0, 0, 0, 0, 0, 0, 1, 0, & !
0, 0, 0, 0, 0, 0, 0, 1, & !
1, 1, 0, 0, 0, 0, 0, 0, & !
0, 1, 1, 0, 0, 0, 0, 0, & ! 10
0, 0, 1, 1, 0, 0, 0, 0, & !
1, 0, 0, 1, 0, 0, 0, 0, & !
1, 0, 0, 0, 1, 0, 0, 0, & !
0, 1, 0, 0, 0, 1, 0, 0, & !
0, 0, 1, 0, 0, 0, 1, 0, & ! 15
0, 0, 0, 1, 0, 0, 0, 1, & !
0, 0, 0, 0, 1, 1, 0, 0, & !
0, 0, 0, 0, 0, 1, 1, 0, & !
0, 0, 0, 0, 0, 0, 1, 1, & !
0, 0, 0, 0, 1, 0, 0, 1, & ! 20
1, 1, 1, 1, 0, 0, 0, 0, & !
1, 1, 0, 0, 1, 1, 0, 0, & !
0, 1, 1, 0, 0, 1, 1, 0, & !
0, 0, 1, 1, 0, 0, 1, 1, & !
1, 0, 0, 1, 1, 0, 0, 1, & ! 25
0, 0, 0, 0, 1, 1, 1, 1, & !
1, 1, 1, 1, 1, 1, 1, 1 & !
],pReal),[nNode(11),NcellNode(geomType(11))]) ! 3D 8node 8ip
real(pReal), dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = &
reshape(real([&
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20
1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & !
1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & !
0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & !
0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & !
1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25
0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & !
3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & !
],pReal),[nNode(12),NcellNode(geomType(12))]) ! 3D 20node 8ip
real(pReal), dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = &
reshape(real([&
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10
0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & !
1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & !
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & !
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & !
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & !
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & !
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & !
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & !
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & !
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & !
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & !
4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & !
1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & !
1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35
1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & !
4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & !
1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & !
0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & !
0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40
0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & !
0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & !
1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & !
4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & !
1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45
1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & !
0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & !
0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & !
0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & !
0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50
1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & !
1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & !
0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & !
0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & !
0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55
0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & !
24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & !
8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & !
4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & !
8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60
8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & !
4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & !
3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & !
4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & !
],pReal),[nNode(13),NcellNode(geomType(13))]) ! 3D 20node 27ip
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = &
reshape(int([&
1,2,3 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = &
reshape(int([&
1, 4, 7, 6, &
2, 5, 7, 4, &
3, 6, 7, 5 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = &
reshape(int([&
1, 5, 9, 8, &
5, 2, 6, 9, &
8, 9, 7, 4, &
9, 6, 3, 7 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = &
reshape(int([&
1, 5,13,12, &
5, 6,14,13, &
6, 2, 7,14, &
12,13,16,11, &
13,14,15,16, &
14, 7, 8,15, &
11,16,10, 4, &
16,15, 9,10, &
15, 8, 3, 9 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = &
reshape(int([&
1, 2, 3, 4 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = &
reshape(int([&
1, 5,11, 7, 8,12,15,14, &
5, 2, 6,11,12, 9,13,15, &
7,11, 6, 3,14,15,13,10, &
8,12,15, 4, 4, 9,13,10 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = &
reshape(int([&
1, 7,16, 9,10,17,21,19, &
7, 2, 8,16,17,11,18,21, &
9,16, 8, 3,19,21,18,12, &
10,17,21,19, 4,13,20,15, &
17,11,18,21,13, 5,14,20, &
19,21,18,12,15,20,14, 6 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = &
reshape(int([&
1, 2, 3, 4, 5, 6, 7, 8 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = &
reshape(int([&
1, 9,21,12,13,22,27,25, &
9, 2,10,21,22,14,23,27, &
12,21,11, 4,25,27,24,16, &
21,10, 3,11,27,23,15,24, &
13,22,27,25, 5,17,26,20, &
22,14,23,27,17, 6,18,26, &
25,27,24,16,20,26,19, 8, &
27,23,15,24,26,18, 7,19 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)])
integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = &
reshape(int([&
1, 9,33,16,17,37,57,44, &
9,10,34,33,37,38,58,57, &
10, 2,11,34,38,18,39,58, &
16,33,36,15,44,57,60,43, &
33,34,35,36,57,58,59,60, &
34,11,12,35,58,39,40,59, &
15,36,14, 4,43,60,42,20, &
36,35,13,14,60,59,41,42, &
35,12, 3,13,59,40,19,41, &
17,37,57,44,21,45,61,52, &
37,38,58,57,45,46,62,61, &
38,18,39,58,46,22,47,62, &
44,57,60,43,52,61,64,51, &
57,58,59,60,61,62,63,64, &
58,39,40,59,62,47,48,63, &
43,60,42,20,51,64,50,24, &
60,59,41,42,64,63,49,50, &
59,40,19,41,63,48,23,49, &
21,45,61,52, 5,25,53,32, &
45,46,62,61,25,26,54,53, &
46,22,47,62,26, 6,27,54, &
52,61,64,51,32,53,56,31, &
61,62,63,64,53,54,55,56, &
62,47,48,63,54,27,28,55, &
51,64,50,24,31,56,30, 8, &
64,63,49,50,56,55,29,30, &
63,48,23,49,55,28, 7,29 &
],pInt),[NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)])
integer(pInt), dimension(NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)), parameter :: CELLFACE1 = &
reshape(int([&
2,3, &
3,1, &
1,2 &
],pInt),[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) ! 2D 3node, VTK_TRIANGLE (5)
integer(pInt), dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = &
reshape(int([&
2,3, &
4,1, &
3,4, &
1,2 &
],pInt),[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) ! 2D 4node, VTK_QUAD (9)
integer(pInt), dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = &
reshape(int([&
1,3,2, &
1,2,4, &
2,3,4, &
1,4,3 &
],pInt),[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) ! 3D 4node, VTK_TETRA (10)
integer(pInt), dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = &
reshape(int([&
2,3,7,6, &
4,1,5,8, &
3,4,8,7, &
1,2,6,5, &
5,6,7,8, &
1,4,3,2 &
],pInt),[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) ! 3D 8node, VTK_HEXAHEDRON (12)
contains
subroutine tElement_init(self,elemType)
implicit none
class(tElement) :: self
integer(pInt), intent(in) :: elemType
self%elemType = elemType
self%Nnodes = Nnode (self%elemType)
self%geomType = geomType (self%elemType)
select case (self%elemType)
case(1_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights1
case(2_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights2
case(3_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights3
case(4_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights4
case(5_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights5
case(6_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights6
case(7_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights7
case(8_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights8
case(9_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights9
case(10_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights10
case(11_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights11
case(12_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights12
case(13_pInt)
self%cellNodeParentNodeWeights = cellNodeParentNodeWeights13
case default
print*, 'Mist'
end select
self%NcellNodes = NcellNode (self%geomType)
self%maxNnodeAtIP = maxNnodeAtIP (self%geomType)
self%nIPs = nIP (self%geomType)
self%cellType = cellType (self%geomType)
select case (self%geomType)
case(1_pInt)
self%NnodeAtIP = NnodeAtIP1
self%IPneighbor = IPneighbor1
self%cell = CELL1
case(2_pInt)
self%NnodeAtIP = NnodeAtIP2
self%IPneighbor = IPneighbor2
self%cell = CELL2
case(3_pInt)
self%NnodeAtIP = NnodeAtIP3
self%IPneighbor = IPneighbor3
self%cell = CELL3
case(4_pInt)
self%NnodeAtIP = NnodeAtIP4
self%IPneighbor = IPneighbor4
self%cell = CELL4
case(5_pInt)
self%NnodeAtIP = NnodeAtIP5
self%IPneighbor = IPneighbor5
self%cell = CELL5
case(6_pInt)
self%NnodeAtIP = NnodeAtIP6
self%IPneighbor = IPneighbor6
self%cell = CELL6
case(7_pInt)
self%NnodeAtIP = NnodeAtIP7
self%IPneighbor = IPneighbor7
self%cell = CELL7
case(8_pInt)
self%NnodeAtIP = NnodeAtIP8
self%IPneighbor = IPneighbor8
self%cell = CELL8
case(9_pInt)
self%NnodeAtIP = NnodeAtIP9
self%IPneighbor = IPneighbor9
self%cell = CELL9
case(10_pInt)
self%NnodeAtIP = NnodeAtIP10
self%IPneighbor = IPneighbor10
self%cell = CELL10
end select
self%NcellNodesPerCell = NCELLNODEPERCELL(self%cellType)
select case(self%cellType)
case(1_pInt)
self%cellFace = CELLFACE1
case(2_pInt)
self%cellFace = CELLFACE2
case(3_pInt)
self%cellFace = CELLFACE3
case(4_pInt)
self%cellFace = CELLFACE4
end select
self%nIPneighbors = size(self%IPneighbor,1)
write(6,'(/,a)') ' <<<+- element_init -+>>>'
write(6,*)' element type ',self%elemType
write(6,*)' geom type ',self%geomType
write(6,*)' cell type ',self%cellType
write(6,*)' # node ',self%Nnodes
write(6,*)' # IP ',self%nIPs
write(6,*)' # cellnode ',self%Ncellnodes
write(6,*)' # cellnode/cell ',self%NcellnodesPerCell
write(6,*)' # IP neighbor ',self%nIPneighbors
write(6,*)' max # node at IP ',self%maxNnodeAtIP
end subroutine tElement_init
end module element

41
src/homogenization.f90
View File

@ -71,11 +71,8 @@ subroutine homogenization_init
debug_e, &
debug_g
use mesh, only: &
mesh_maxNips, &
mesh_NcpElems, &
mesh_element, &
FE_Nips, &
FE_geomtype
theMesh, &
mesh_element
use constitutive, only: &
constitutive_plasticity_maxSizePostResults, &
constitutive_source_maxSizePostResults
@ -244,20 +241,20 @@ subroutine homogenization_init
!--------------------------------------------------------------------------------------------------
! allocate and initialize global variables
allocate(materialpoint_dPdF(3,3,3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_F0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
materialpoint_F0 = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity
allocate(materialpoint_F(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_dPdF(3,3,3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_F0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems) ! initialize to identity
allocate(materialpoint_F(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
materialpoint_F = materialpoint_F0 ! initialize to identity
allocate(materialpoint_subF0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_subF(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_P(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_subFrac(mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_subStep(mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_subdt(mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
allocate(materialpoint_requested(mesh_maxNips,mesh_NcpElems), source=.false.)
allocate(materialpoint_converged(mesh_maxNips,mesh_NcpElems), source=.true.)
allocate(materialpoint_doneAndHappy(2,mesh_maxNips,mesh_NcpElems), source=.true.)
allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subF(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_P(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subFrac(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subStep(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_subdt(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
allocate(materialpoint_requested(theMesh%elem%nIPs,theMesh%nElems), source=.false.)
allocate(materialpoint_converged(theMesh%elem%nIPs,theMesh%nElems), source=.true.)
allocate(materialpoint_doneAndHappy(2,theMesh%elem%nIPs,theMesh%nElems), source=.true.)
!--------------------------------------------------------------------------------------------------
! allocate and initialize global state and postresutls variables
@ -277,7 +274,7 @@ subroutine homogenization_init
+ homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results
+ 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results
+ constitutive_source_maxSizePostResults)
allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems))
allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems))
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -346,7 +343,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
crystallite_Lp, &
crystallite_Li0, &
crystallite_Li, &
crystallite_dPdF, &
crystallite_Tstar0_v, &
crystallite_Tstar_v, &
crystallite_partionedF0, &
@ -600,7 +596,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
if ( materialpoint_requested(i,e) .and. & ! process requested but...
.not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points
call partitionDeformation(i,e) ! partition deformation onto constituents
call partitionDeformation(i,e) ! partition deformation onto constituents
crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e) ! propagate materialpoint dt to grains
crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents
else
@ -614,7 +610,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
! crystallite integration
! based on crystallite_partionedF0,.._partionedF
! incrementing by crystallite_dt
materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic
materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic
!--------------------------------------------------------------------------------------------------
! state update

180
src/kinematics_cleavage_opening.f90
View File

@ -11,20 +11,22 @@ module kinematics_cleavage_opening
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_cleavage_opening_sizePostResults, & !< cumulative size of post results
kinematics_cleavage_opening_offset, & !< which kinematics is my current damage mechanism?
kinematics_cleavage_opening_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:), allocatable, private :: kinematics_cleavage_opening_instance
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_cleavage_opening_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_cleavage_opening_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_cleavage_opening_Noutput !< number of outputs per instance of this damage
type, private :: tParameters !< container type for internal constitutive parameters
integer(pInt) :: &
totalNcleavage
integer(pInt), dimension(:), allocatable :: &
Ncleavage !< active number of cleavage systems per family
real(pReal) :: &
sdot0, &
n
real(pReal), dimension(:), allocatable :: &
critDisp, &
critLoad
end type
! Begin Deprecated
integer(pInt), dimension(:), allocatable, private :: &
kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems
@ -38,6 +40,7 @@ module kinematics_cleavage_opening
real(pReal), dimension(:,:), allocatable, private :: &
kinematics_cleavage_opening_critDisp, &
kinematics_cleavage_opening_critLoad
! End Deprecated
public :: &
kinematics_cleavage_opening_init, &
@ -50,7 +53,7 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_cleavage_opening_init(fileUnit)
subroutine kinematics_cleavage_opening_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
@ -60,41 +63,25 @@ subroutine kinematics_cleavage_opening_init(fileUnit)
debug_level,&
debug_constitutive,&
debug_levelBasic
use config, only: &
config_phase
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
IO_timeStamp
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_cleavage_opening_label, &
KINEMATICS_cleavage_opening_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use lattice, only: &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: tempInt
real(pReal), allocatable, dimension(:) :: tempFloat
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: maxNinstance,p,instance,kinematics
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -106,21 +93,11 @@ subroutine kinematics_cleavage_opening_init(fileUnit)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_cleavage_opening_offset(material_Nphase), source=0_pInt)
allocate(kinematics_cleavage_opening_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_cleavage_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_cleavage_opening_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_cleavage_opening_ID) &
kinematics_cleavage_opening_offset(phase) = kinematics
enddo
allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0_pInt)
do p = 1_pInt, size(config_phase)
kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct?
enddo
allocate(kinematics_cleavage_opening_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_output(maxval(phase_Noutput),maxNinstance))
kinematics_cleavage_opening_output = ''
allocate(kinematics_cleavage_opening_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt)
@ -128,90 +105,51 @@ subroutine kinematics_cleavage_opening_init(fileUnit)
allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal)
allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = kinematics_cleavage_opening_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('anisobrittle_sdot0')
kinematics_cleavage_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('anisobrittle_ratesensitivity')
kinematics_cleavage_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('ncleavage') !
Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt
do j = 1_pInt, Nchunks_CleavageFamilies
kinematics_cleavage_opening_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j)
enddo
do p = 1_pInt, size(config_phase)
if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle
instance = kinematics_cleavage_opening_instance(p)
kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0')
kinematics_cleavage_opening_N(instance) = config_phase(p)%getFloat('anisobrittle_ratesensitivity')
tempInt = config_phase(p)%getInts('ncleavage')
kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt
case ('anisobrittle_criticaldisplacement')
do j = 1_pInt, Nchunks_CleavageFamilies
kinematics_cleavage_opening_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt))
kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat
case ('anisobrittle_criticalload')
do j = 1_pInt, Nchunks_CleavageFamilies
kinematics_cleavage_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt))
kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat
end select
endif; endif
enddo parsingFile
!--------------------------------------------------------------------------------------------------
! sanity checks
sanityChecks: do phase = 1_pInt, material_Nphase
myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then
instance = kinematics_cleavage_opening_instance(phase)
kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = &
min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested
kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = &
min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),& ! limit active cleavage systems per family to min of available and requested
kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance))
kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether
if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')')
if (any(kinematics_cleavage_opening_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) &
if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')')
if (any(kinematics_cleavage_opening_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) &
if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')')
if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')')
endif myPhase
enddo sanityChecks
enddo
end subroutine kinematics_cleavage_opening_init
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el)
subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
use prec, only: &
tol_math_check
use math, only: &
math_mul33xx33
use material, only: &
phaseAt, phasememberAt, &
material_phase, &
material_homog, &
damage, &
damageMapping
use lattice, only: &
lattice_Scleavage, &
lattice_Scleavage_v, &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
@ -220,36 +158,33 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(in), dimension(6) :: &
Tstar_v !< 2nd Piola-Kirchhoff stress
real(pReal), intent(in), dimension(3,3) :: &
S
real(pReal), intent(out), dimension(3,3) :: &
Ld !< damage velocity gradient
real(pReal), intent(out), dimension(3,3,3,3) :: &
dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor)
dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor)
integer(pInt) :: &
phase, &
constituent, &
instance, &
instance, phase, &
homog, damageOffset, &
f, i, index_myFamily, k, l, m, n
real(pReal) :: &
traction_d, traction_t, traction_n, traction_crit, &
udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
phase = material_phase(ipc,ip,el)
instance = kinematics_cleavage_opening_instance(phase)
homog = material_homog(ip,el)
damageOffset = damageMapping(homog)%p(ip,el)
Ld = 0.0_pReal
dLd_dTstar3333 = 0.0_pReal
dLd_dTstar = 0.0_pReal
do f = 1_pInt,lattice_maxNcleavageFamily
index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family
do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family
traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase))
traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase))
traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase))
traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase))
traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* &
damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset)
udotd = &
@ -261,7 +196,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar
dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ &
max(0.0_pReal, abs(traction_d) - traction_crit)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* &
lattice_Scleavage(m,n,1,index_myFamily+i,phase)
endif
@ -275,7 +210,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar
dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ &
max(0.0_pReal, abs(traction_t) - traction_crit)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* &
lattice_Scleavage(m,n,2,index_myFamily+i,phase)
endif
@ -289,11 +224,10 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar
dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ &
max(0.0_pReal, abs(traction_n) - traction_crit)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* &
lattice_Scleavage(m,n,3,index_myFamily+i,phase)
endif
enddo
enddo

190
src/kinematics_slipplane_opening.f90
View File

@ -11,20 +11,22 @@ module kinematics_slipplane_opening
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
kinematics_slipplane_opening_sizePostResults, & !< cumulative size of post results
kinematics_slipplane_opening_offset, & !< which kinematics is my current damage mechanism?
kinematics_slipplane_opening_instance !< instance of damage kinematics mechanism
integer(pInt), dimension(:,:), allocatable, target, public :: &
kinematics_slipplane_opening_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
kinematics_slipplane_opening_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_slipplane_opening_Noutput !< number of outputs per instance of this damage
integer(pInt), dimension(:), allocatable, private :: kinematics_slipplane_opening_instance
type, private :: tParameters !< container type for internal constitutive parameters
integer(pInt) :: &
totalNslip
integer(pInt), dimension(:), allocatable :: &
Nslip !< active number of slip systems per family
real(pReal) :: &
sdot0, &
n
real(pReal), dimension(:), allocatable :: &
critDisp, &
critPlasticStrain
end type
! Begin Deprecated
integer(pInt), dimension(:), allocatable, private :: &
kinematics_slipplane_opening_totalNslip !< total number of slip systems
@ -38,6 +40,7 @@ module kinematics_slipplane_opening
real(pReal), dimension(:,:), allocatable, private :: &
kinematics_slipplane_opening_critPlasticStrain, &
kinematics_slipplane_opening_critLoad
! End Deprecated
public :: &
kinematics_slipplane_opening_init, &
@ -50,7 +53,7 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine kinematics_slipplane_opening_init(fileUnit)
subroutine kinematics_slipplane_opening_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
@ -60,41 +63,25 @@ subroutine kinematics_slipplane_opening_init(fileUnit)
debug_level,&
debug_constitutive,&
debug_levelBasic
use config, only: &
config_phase
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
IO_timeStamp
use material, only: &
phase_kinematics, &
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_slipplane_opening_label, &
KINEMATICS_slipplane_opening_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: tempInt
real(pReal), allocatable, dimension(:) :: tempFloat
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,phase,instance,kinematics
integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: maxNinstance,p,instance,kinematics
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -106,21 +93,11 @@ subroutine kinematics_slipplane_opening_init(fileUnit)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(kinematics_slipplane_opening_offset(material_Nphase), source=0_pInt)
allocate(kinematics_slipplane_opening_instance(material_Nphase), source=0_pInt)
do phase = 1, material_Nphase
kinematics_slipplane_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_slipplane_opening_ID)
do kinematics = 1, phase_Nkinematics(phase)
if (phase_kinematics(kinematics,phase) == kinematics_slipplane_opening_ID) &
kinematics_slipplane_opening_offset(phase) = kinematics
enddo
allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0_pInt)
do p = 1_pInt, size(config_phase)
kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct?
enddo
allocate(kinematics_slipplane_opening_sizePostResults(maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(kinematics_slipplane_opening_output(maxval(phase_Noutput),maxNinstance))
kinematics_slipplane_opening_output = ''
allocate(kinematics_slipplane_opening_Noutput(maxNinstance), source=0_pInt)
allocate(kinematics_slipplane_opening_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal)
allocate(kinematics_slipplane_opening_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal)
allocate(kinematics_slipplane_opening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt)
@ -128,61 +105,22 @@ subroutine kinematics_slipplane_opening_init(fileUnit)
allocate(kinematics_slipplane_opening_N(maxNinstance), source=0.0_pReal)
allocate(kinematics_slipplane_opening_sdot_0(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = kinematics_slipplane_opening_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('nslip') !
Nchunks_SlipFamilies = chunkPos(1) - 1_pInt
do j = 1_pInt, Nchunks_SlipFamilies
kinematics_slipplane_opening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j)
enddo
do p = 1_pInt, size(config_phase)
if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle
instance = kinematics_slipplane_opening_instance(p)
kinematics_slipplane_opening_sdot_0(instance) = config_phase(p)%getFloat('anisoductile_sdot0')
kinematics_slipplane_opening_N(instance) = config_phase(p)%getFloat('anisoductile_ratesensitivity')
tempInt = config_phase(p)%getInts('ncleavage')
kinematics_slipplane_opening_Nslip(1:size(tempInt),instance) = tempInt
case ('anisoductile_sdot0')
kinematics_slipplane_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('anisoductile_criticalplasticstrain')
do j = 1_pInt, Nchunks_SlipFamilies
kinematics_slipplane_opening_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
case ('anisoductile_ratesensitivity')
kinematics_slipplane_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt)
tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(tempInt))
kinematics_slipplane_opening_critPlasticStrain(1:size(tempInt),instance) = tempFloat
case ('anisoductile_criticalload')
do j = 1_pInt, Nchunks_SlipFamilies
kinematics_slipplane_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
end select
endif; endif
enddo parsingFile
tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(tempInt))
kinematics_slipplane_opening_critLoad(1:size(tempInt),instance) = tempFloat
!--------------------------------------------------------------------------------------------------
! sanity checks
sanityChecks: do phase = 1_pInt, material_Nphase
myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then
instance = kinematics_slipplane_opening_instance(phase)
kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = &
min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested
min(lattice_NslipSystem(1:lattice_maxNslipFamily,p),& ! limit active cleavage systems per family to min of available and requested
kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance))
kinematics_slipplane_opening_totalNslip(instance) = sum(kinematics_slipplane_opening_Nslip(:,instance))
if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) &
@ -191,18 +129,18 @@ subroutine kinematics_slipplane_opening_init(fileUnit)
call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')')
if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')')
endif myPhase
enddo sanityChecks
enddo
end subroutine kinematics_slipplane_opening_init
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
!--------------------------------------------------------------------------------------------------
subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el)
subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
use prec, only: &
tol_math_check
use math, only: &
math_mul33xx33
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
@ -210,53 +148,41 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta
lattice_st, &
lattice_sn
use material, only: &
phaseAt, phasememberAt, &
material_phase, &
material_homog, &
damage, &
damageMapping
use math, only: &
math_Plain3333to99, &
math_I3, &
math_identity4th, &
math_symmetric33, &
math_Mandel33to6, &
math_tensorproduct33, &
math_det33, &
math_mul33x33
math_tensorproduct33
implicit none
integer(pInt), intent(in) :: &
ipc, & !< grain number
ip, & !< integration point number
el !< element number
real(pReal), intent(in), dimension(6) :: &
Tstar_v !< 2nd Piola-Kirchhoff stress
real(pReal), intent(in), dimension(3,3) :: &
S
real(pReal), intent(out), dimension(3,3) :: &
Ld !< damage velocity gradient
real(pReal), intent(out), dimension(3,3,3,3) :: &
dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor)
dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor)
real(pReal), dimension(3,3) :: &
projection_d, projection_t, projection_n !< projection modes 3x3 tensor
real(pReal), dimension(6) :: &
projection_d_v, projection_t_v, projection_n_v !< projection modes 3x3 vector
integer(pInt) :: &
phase, &
constituent, &
instance, &
instance, phase, &
homog, damageOffset, &
f, i, index_myFamily, k, l, m, n
real(pReal) :: &
traction_d, traction_t, traction_n, traction_crit, &
udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
phase = material_phase(ipc,ip,el)
instance = kinematics_slipplane_opening_instance(phase)
homog = material_homog(ip,el)
damageOffset = damageMapping(homog)%p(ip,el)
Ld = 0.0_pReal
dLd_dTstar3333 = 0.0_pReal
dLd_dTstar = 0.0_pReal
do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family
do i = 1_pInt,kinematics_slipplane_opening_Nslip(f,instance) ! process each (active) slip system in family
@ -267,13 +193,10 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta
projection_n = math_tensorproduct33(lattice_sn(1:3,index_myFamily+i,phase),&
lattice_sn(1:3,index_myFamily+i,phase))
projection_d_v(1:6) = math_Mandel33to6(math_symmetric33(projection_d(1:3,1:3)))
projection_t_v(1:6) = math_Mandel33to6(math_symmetric33(projection_t(1:3,1:3)))
projection_n_v(1:6) = math_Mandel33to6(math_symmetric33(projection_n(1:3,1:3)))
traction_d = dot_product(Tstar_v,projection_d_v(1:6))
traction_t = dot_product(Tstar_v,projection_t_v(1:6))
traction_n = dot_product(Tstar_v,projection_n_v(1:6))
traction_d = math_mul33xx33(S,projection_d)
traction_t = math_mul33xx33(S,projection_t)
traction_n = math_mul33xx33(S,projection_n)
traction_crit = kinematics_slipplane_opening_critLoad(f,instance)* &
damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage
@ -287,7 +210,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta
Ld = Ld + udotd*projection_d
dudotd_dt = udotd*kinematics_slipplane_opening_N(instance)/traction_d
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotd_dt*projection_d(k,l)*projection_d(m,n)
endif
@ -300,9 +223,10 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta
Ld = Ld + udott*projection_t
dudott_dt = udott*kinematics_slipplane_opening_N(instance)/traction_t
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudott_dt*projection_t(k,l)*projection_t(m,n)
endif
udotn = &
kinematics_slipplane_opening_sdot_0(instance)* &
(max(0.0_pReal,traction_n)/traction_crit - &
@ -311,7 +235,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta
Ld = Ld + udotn*projection_n
dudotn_dt = udotn*kinematics_slipplane_opening_N(instance)/traction_n
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + &
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
dudotn_dt*projection_n(k,l)*projection_n(m,n)
endif
enddo

8
src/kinematics_thermal_expansion.f90
View File

@ -24,10 +24,10 @@ module kinematics_thermal_expansion
integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage
! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult
! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output
! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput...
! end enum
enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult
enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output
thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput...
end enum
public :: &
kinematics_thermal_expansion_init, &
kinematics_thermal_expansion_initialStrain, &

11
src/lattice.f90
View File

@ -31,8 +31,7 @@ module lattice
lattice_Scleavage !< Schmid matrices for cleavage systems
real(pReal), allocatable, dimension(:,:,:,:), protected, public :: &
lattice_Sslip_v, & !< Mandel notation of lattice_Sslip
lattice_Scleavage_v !< Mandel notation of lattice_Scleavege
lattice_Sslip_v !< Mandel notation of lattice_Sslip
real(pReal), allocatable, dimension(:,:,:), protected, public :: &
lattice_sn, & !< normal direction of slip system
@ -776,7 +775,6 @@ subroutine lattice_init
allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me
allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal)
allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal)
allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt)
allocate(CoverA(Nphases),source=0.0_pReal)
@ -1060,13 +1058,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
enddo
enddo
do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure
do j = 1_pInt,3_pInt
lattice_Scleavage_v(1:6,j,i,myPhase) = &
math_sym33to6(math_symmetric33(lattice_Scleavage(1:3,1:3,j,i,myPhase)))
enddo
enddo
end subroutine lattice_initializeStructure

104
src/material.f90
View File

@ -235,6 +235,7 @@ module material
public :: &
material_init, &
material_allocatePlasticState, &
material_allocateSourceState, &
ELASTICITY_hooke_ID ,&
PLASTICITY_none_ID, &
PLASTICITY_isotropic_ID, &
@ -305,9 +306,7 @@ subroutine material_init()
texture_name
use mesh, only: &
mesh_homogenizationAt, &
mesh_NipsPerElem, &
mesh_NcpElems, &
FE_geomtype
theMesh
implicit none
integer(pInt), parameter :: FILEUNIT = 210_pInt
@ -399,10 +398,10 @@ subroutine material_init()
call material_populateGrains
! BEGIN DEPRECATED
allocate(phaseAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt)
allocate(phasememberAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt)
allocate(mappingHomogenization (2, mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt)
allocate(mappingHomogenizationConst( mesh_nIPsPerElem,mesh_NcpElems),source=1_pInt)
allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt)
! END DEPRECATED
allocate(material_homogenizationAt,source=mesh_homogenizationAt)
@ -410,9 +409,9 @@ subroutine material_init()
allocate(CounterHomogenization(size(config_homogenization)),source=0_pInt)
! BEGIN DEPRECATED
do e = 1_pInt,mesh_NcpElems
do e = 1_pInt,theMesh%Nelems
myHomog = mesh_homogenizationAt(e)
do i = 1_pInt, mesh_NipsPerElem
do i = 1_pInt, theMesh%elem%nIPs
CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt
mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),myHomog]
do g = 1_pInt,homogenization_Ngrains(myHomog)
@ -553,7 +552,7 @@ subroutine material_parseMicrostructure
microstructure_name
use mesh, only: &
mesh_microstructureAt, &
mesh_NcpElems
theMesh
implicit none
character(len=65536), dimension(:), allocatable :: &
@ -571,7 +570,7 @@ subroutine material_parseMicrostructure
if(any(mesh_microstructureAt > size(config_microstructure))) &
call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config')
forall (e = 1_pInt:mesh_NcpElems) &
forall (e = 1_pInt:theMesh%Nelems) &
microstructure_active(mesh_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
do m=1_pInt, size(config_microstructure)
@ -966,6 +965,49 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,&
end subroutine material_allocatePlasticState
!--------------------------------------------------------------------------------------------------
!> @brief allocates the source state of a phase
!--------------------------------------------------------------------------------------------------
subroutine material_allocateSourceState(phase,of,NofMyPhase,&
sizeState,sizeDotState,sizeDeltaState)
use numerics, only: &
numerics_integrator2 => numerics_integrator ! compatibility hack
implicit none
integer(pInt), intent(in) :: &
phase, &
of, &
NofMyPhase, &
sizeState, sizeDotState,sizeDeltaState
integer(pInt) :: numerics_integrator ! compatibility hack
numerics_integrator = numerics_integrator2(1) ! compatibility hack
sourceState(phase)%p(of)%sizeState = sizeState
sourceState(phase)%p(of)%sizeDotState = sizeDotState
sourceState(phase)%p(of)%sizeDeltaState = sizeDeltaState
plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition
allocate(sourceState(phase)%p(of)%aTolState (sizeState), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (numerics_integrator == 1_pInt) then
allocate(sourceState(phase)%p(of)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (numerics_integrator == 4_pInt) &
allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (numerics_integrator == 5_pInt) &
allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
end subroutine material_allocateSourceState
!--------------------------------------------------------------------------------------------------
!> @brief populates the grains
!> @details populates the grains by identifying active microstructure/homogenization pairs,
@ -984,13 +1026,10 @@ subroutine material_populateGrains
math_sampleFiberOri, &
math_symmetricEulers
use mesh, only: &
mesh_NipsPerElem, &
mesh_elemType, &
mesh_homogenizationAt, &
mesh_microstructureAt, &
mesh_NcpElems, &
mesh_ipVolume, &
FE_geomtype
theMesh, &
mesh_ipVolume
use config, only: &
config_homogenization, &
config_microstructure, &
@ -1026,24 +1065,24 @@ subroutine material_populateGrains
myDebug = debug_level(debug_material)
allocate(material_volume(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0.0_pReal)
allocate(material_phase(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt)
allocate(material_homog(mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt)
allocate(material_texture(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt)
allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0.0_pReal)
allocate(material_volume(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0.0_pReal)
allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_homog(theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt)
allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal)
allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt)
allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt)
! populating homogenization schemes in each
!--------------------------------------------------------------------------------------------------
do e = 1_pInt, mesh_NcpElems
material_homog(1_pInt:mesh_NipsPerElem,e) = mesh_homogenizationAt(e)
do e = 1_pInt, theMesh%Nelems
material_homog(1_pInt:theMesh%elem%nIPs,e) = mesh_homogenizationAt(e)
enddo
!--------------------------------------------------------------------------------------------------
! precounting of elements for each homog/micro pair
do e = 1_pInt, mesh_NcpElems
do e = 1_pInt, theMesh%Nelems
homog = mesh_homogenizationAt(e)
micro = mesh_microstructureAt(e)
Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt
@ -1061,8 +1100,7 @@ subroutine material_populateGrains
!--------------------------------------------------------------------------------------------------
! identify maximum grain count per IP (from element) and find grains per homog/micro pair
Nelems = 0_pInt ! reuse as counter
elementLooping: do e = 1_pInt,mesh_NcpElems
t = mesh_elemType
elementLooping: do e = 1_pInt,theMesh%Nelems
homog = mesh_homogenizationAt(e)
micro = mesh_microstructureAt(e)
if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds
@ -1072,7 +1110,7 @@ subroutine material_populateGrains
if (microstructure_elemhomo(micro)) then ! how many grains are needed at this element?
dGrains = homogenization_Ngrains(homog) ! only one set of Ngrains (other IPs are plain copies)
else
dGrains = homogenization_Ngrains(homog) * mesh_NipsPerElem ! each IP has Ngrains
dGrains = homogenization_Ngrains(homog) * theMesh%elem%nIPs ! each IP has Ngrains
endif
Ngrains(homog,micro) = Ngrains(homog,micro) + dGrains ! total grain count
Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt ! total element count
@ -1106,16 +1144,15 @@ subroutine material_populateGrains
do hme = 1_pInt, Nelems(homog,micro)
e = elemsOfHomogMicro(homog,micro)%p(hme) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
t = mesh_elemType
if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs
volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:mesh_NipsPerElem,e))/&
volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:theMesh%elem%nIPs,e))/&
real(dGrains,pReal) ! each grain combines size of all IPs in that element
grain = grain + dGrains ! wind forward by Ngrains@IP
else
forall (i = 1_pInt:mesh_NipsPerElem) & ! loop over IPs
forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over IPs
volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = &
mesh_ipVolume(i,e)/real(dGrains,pReal) ! assign IPvolume/Ngrains@IP to all grains of IP
grain = grain + mesh_NipsPerElem * dGrains ! wind forward by Nips*Ngrains@IP
grain = grain + theMesh%elem%nIPs * dGrains ! wind forward by Nips*Ngrains@IP
endif
enddo
@ -1261,11 +1298,10 @@ subroutine material_populateGrains
do hme = 1_pInt, Nelems(homog,micro)
e = elemsOfHomogMicro(homog,micro)%p(hme) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
t = mesh_elemType
if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs
m = 1_pInt ! process only first IP
else
m = mesh_NipsPerElem
m = theMesh%elem%nIPs
endif
do i = 1_pInt, m ! loop over necessary IPs
@ -1303,7 +1339,7 @@ subroutine material_populateGrains
enddo
do i = i, mesh_NipsPerElem ! loop over IPs to (possibly) distribute copies from first IP
do i = i, theMesh%elem%nIPs ! loop over IPs to (possibly) distribute copies from first IP
material_volume (1_pInt:dGrains,i,e) = material_volume (1_pInt:dGrains,1,e)
material_phase (1_pInt:dGrains,i,e) = material_phase (1_pInt:dGrains,1,e)
material_texture(1_pInt:dGrains,i,e) = material_texture(1_pInt:dGrains,1,e)

93
src/math.f90
View File

@ -118,6 +118,9 @@ module math
!---------------------------------------------------------------------------------------------------
public :: &
#if defined(__PGI)
norm2, &
#endif
math_init, &
math_qsort, &
math_expand, &
@ -351,20 +354,38 @@ end subroutine math_check
!--------------------------------------------------------------------------------------------------
!> @brief Quicksort algorithm for two-dimensional integer arrays
! Sorting is done with respect to array(1,:)
! and keeps array(2:N,:) linked to it.
! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it.
! default: sort=1
!--------------------------------------------------------------------------------------------------
recursive subroutine math_qsort(a, istart, iend)
recursive subroutine math_qsort(a, istart, iend, sortDim)
implicit none
integer(pInt), dimension(:,:), intent(inout) :: a
integer(pInt), intent(in) :: istart,iend
integer(pInt) :: ipivot
if (istart < iend) then
ipivot = qsort_partition(a,istart, iend)
call math_qsort(a, istart, ipivot-1_pInt)
call math_qsort(a, ipivot+1_pInt, iend)
integer(pInt), intent(in),optional :: istart,iend, sortDim
integer(pInt) :: ipivot,s,e,d
if(present(istart)) then
s = istart
else
s = lbound(a,2)
endif
if(present(iend)) then
e = iend
else
e = ubound(a,2)
endif
if(present(sortDim)) then
d = sortDim
else
d = 1
endif
if (s < e) then
ipivot = qsort_partition(a,s, e, d)
call math_qsort(a, s, ipivot-1_pInt, d)
call math_qsort(a, ipivot+1_pInt, e, d)
endif
!--------------------------------------------------------------------------------------------------
@ -373,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend)
!-------------------------------------------------------------------------------------------------
!> @brief Partitioning required for quicksort
!-------------------------------------------------------------------------------------------------
integer(pInt) function qsort_partition(a, istart, iend)
integer(pInt) function qsort_partition(a, istart, iend, sort)
implicit none
integer(pInt), dimension(:,:), intent(inout) :: a
integer(pInt), intent(in) :: istart,iend
integer(pInt) :: i,j,k,tmp
integer(pInt), intent(in) :: istart,iend,sort
integer(pInt), dimension(size(a,1)) :: tmp
integer(pInt) :: i,j
do
! find the first element on the right side less than or equal to the pivot point
! find the first element on the right side less than or equal to the pivot point
do j = iend, istart, -1_pInt
if (a(1,j) <= a(1,istart)) exit
if (a(sort,j) <= a(sort,istart)) exit
enddo
! find the first element on the left side greater than the pivot point
! find the first element on the left side greater than the pivot point
do i = istart, iend
if (a(1,i) > a(1,istart)) exit
if (a(sort,i) > a(sort,istart)) exit
enddo
if (i < j) then ! if the indexes do not cross, exchange values
do k = 1_pInt, int(size(a,1_pInt), pInt)
tmp = a(k,i)
a(k,i) = a(k,j)
a(k,j) = tmp
enddo
else ! if they do cross, exchange left value with pivot and return with the partition index
do k = 1_pInt, int(size(a,1_pInt), pInt)
tmp = a(k,istart)
a(k,istart) = a(k,j)
a(k,j) = tmp
enddo
cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index
tmp = a(:,istart)
a(:,istart) = a(:,j)
a(:,j) = tmp
qsort_partition = j
return
endif
else cross ! if they do not cross, exchange values
tmp = a(:,i)
a(:,i) = a(:,j)
a(:,j) = tmp
endif cross
enddo
end function qsort_partition
@ -2706,4 +2724,19 @@ real(pReal) pure elemental function math_clip(a, left, right)
end function math_clip
#if defined(__PGI)
!--------------------------------------------------------------------------------------------------
!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10
!--------------------------------------------------------------------------------------------------
real(pReal) pure function norm2(v)
implicit none
real(pReal), intent(in), dimension(3) :: v
norm2 = sqrt(sum(v**2))
end function norm2
#endif
end module math

40
src/meshFEM.f90 → src/mesh_FEM.f90
View File

@ -12,7 +12,7 @@ module mesh
#include <petsc/finclude/petscis.h>
#include <petsc/finclude/petscdmda.h>
use prec, only: pReal, pInt
use mesh_base
use PETScdmplex
use PETScdmda
use PETScis
@ -27,7 +27,6 @@ use PETScis
mesh_NcpElems, & !< total number of CP elements in mesh
mesh_NcpElemsGlobal, &
mesh_Nnodes, & !< total number of nodes in mesh
mesh_NipsPerElem, & !< number of IPs in per element
mesh_maxNipNeighbors
!!!! BEGIN DEPRECATED !!!!!
integer(pInt), public, protected :: &
@ -79,7 +78,17 @@ use PETScis
integer(pInt), dimension(1_pInt), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type
int([6],pInt)
type, public, extends(tMesh) :: tMesh_FEM
contains
procedure, pass(self) :: tMesh_FEM_init
generic, public :: init => tMesh_FEM_init
end type tMesh_FEM
type(tMesh_FEM), public, protected :: theMesh
public :: &
mesh_init, &
@ -89,6 +98,25 @@ use PETScis
contains
subroutine tMesh_FEM_init(self,dimen,order,nodes)
implicit none
integer, intent(in) :: dimen
integer(pInt), intent(in) :: order
real(pReal), intent(in), dimension(:,:) :: nodes
class(tMesh_FEM) :: self
if (dimen == 2_pInt) then
if (order == 1_pInt) call self%tMesh%init('mesh',1_pInt,nodes)
if (order == 2_pInt) call self%tMesh%init('mesh',2_pInt,nodes)
elseif(dimen == 3_pInt) then
if (order == 1_pInt) call self%tMesh%init('mesh',6_pInt,nodes)
if (order == 2_pInt) call self%tMesh%init('mesh',8_pInt,nodes)
endif
end subroutine tMesh_FEM_init
!--------------------------------------------------------------------------------------------------
!> @brief initializes the mesh by calling all necessary private routines the mesh module
@ -213,6 +241,8 @@ subroutine mesh_init()
FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
mesh_maxNips = FE_Nips(1_pInt)
write(6,*) 'mesh_maxNips',mesh_maxNips
call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p)
call mesh_FEM_build_ipVolumes(dimPlex)
@ -238,12 +268,14 @@ subroutine mesh_init()
!!!! COMPATIBILITY HACK !!!!
! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes.
! hence, xxPerElem instead of maxXX
mesh_NipsPerElem = mesh_maxNips
! better name
mesh_homogenizationAt = mesh_element(3,:)
mesh_microstructureAt = mesh_element(4,:)
!!!!!!!!!!!!!!!!!!!!!!!!
allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
call theMesh%init(dimplex,integrationOrder,mesh_node0)
call theMesh%setNelems(mesh_NcpElems)
end subroutine mesh_init

3257
src/mesh.f90 → src/mesh_abaqus.f90
View File

File diff suppressed because it is too large Load Diff

85
src/mesh_base.f90 Normal file
View File

@ -0,0 +1,85 @@
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Sets up the mesh for the solvers MSC.Marc,FEM, Abaqus and the spectral solver
!--------------------------------------------------------------------------------------------------
module mesh_base
use, intrinsic :: iso_c_binding
use prec, only: &
pStringLen, &
pReal, &
pInt
use element, only: &
tElement
implicit none
!---------------------------------------------------------------------------------------------------
!> Properties of a the whole mesh (consisting of one type of elements)
!---------------------------------------------------------------------------------------------------
type, public :: tMesh
type(tElement) :: &
elem
real(pReal), dimension(:,:), allocatable, public :: &
ipVolume, & !< volume associated with each IP (initially!)
node0, & !< node x,y,z coordinates (initially)
node !< node x,y,z coordinates (deformed)
integer(pInt), dimension(:,:), allocatable, public :: &
cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID
character(pStringLen) :: type = "n/a"
integer(pInt) :: &
Nnodes, & !< total number of nodes in mesh
Nelems = -1_pInt, &
elemType, &
Ncells, &
nIPneighbors, &
NcellNodes, &
maxElemsPerNode
integer(pInt), dimension(:), allocatable, public :: &
homogenizationAt, &
microstructureAt
integer(pInt), dimension(:,:), allocatable, public :: &
connectivity
contains
procedure, pass(self) :: tMesh_base_init
procedure :: setNelems => tMesh_base_setNelems ! not needed once we compute the cells from the connectivity
generic, public :: init => tMesh_base_init
end type tMesh
contains
subroutine tMesh_base_init(self,meshType,elemType,nodes)
implicit none
class(tMesh) :: self
character(len=*), intent(in) :: meshType
integer(pInt), intent(in) :: elemType
real(pReal), dimension(:,:), intent(in) :: nodes
write(6,'(/,a)') ' <<<+- mesh_base_init -+>>>'
write(6,*)' mesh type ',meshType
write(6,*)' # node ',size(nodes,2)
self%type = meshType
call self%elem%init(elemType)
self%node0 = nodes
self%nNodes = size(nodes,2)
end subroutine tMesh_base_init
subroutine tMesh_base_setNelems(self,Nelems)
implicit none
class(tMesh) :: self
integer(pInt), intent(in) :: Nelems
self%Nelems = Nelems
end subroutine tMesh_base_setNelems
end module mesh_base

1031
src/mesh_grid.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

1851
src/mesh_marc.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

7
src/numerics.f90
View File

@ -177,13 +177,8 @@ subroutine numerics_init
#include <petsc/finclude/petscsys.h>
use petscsys
#endif
#if !defined(Marc4DAMASK)
!$ use OMP_LIB, only: omp_set_num_threads ! Standard conforming module
!$ use OMP_LIB, only: omp_set_num_threads
implicit none
#else
implicit none
!$ include "omp_lib.h" ! MSC.Marc includes this file on !its own, avoid conflict with the OMP_LIB module
#endif
integer(pInt), parameter :: FILEUNIT = 300_pInt
!$ integer :: gotDAMASK_NUM_THREADS = 1
integer :: i, ierr ! no pInt

716
src/plastic_nonlocal.f90
View File

File diff suppressed because it is too large Load Diff

376
src/source_damage_anisoBrittle.f90
View File

@ -12,7 +12,6 @@ module source_damage_anisoBrittle
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_anisoBrittle_sizePostResults, & !< cumulative size of post results
source_damage_anisoBrittle_offset, & !< which source is my current source mechanism?
source_damage_anisoBrittle_instance !< instance of source mechanism
@ -22,31 +21,32 @@ module source_damage_anisoBrittle
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_anisoBrittle_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_anisoBrittle_Noutput !< number of outputs per instance of this source
integer(pInt), dimension(:), allocatable, private :: &
source_damage_anisoBrittle_totalNcleavage !< total number of cleavage systems
integer(pInt), dimension(:,:), allocatable, private :: &
source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family
real(pReal), dimension(:), allocatable, private :: &
source_damage_anisoBrittle_aTol, &
source_damage_anisoBrittle_sdot_0, &
source_damage_anisoBrittle_N
real(pReal), dimension(:,:), allocatable, private :: &
source_damage_anisoBrittle_critDisp, &
source_damage_anisoBrittle_critLoad
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_anisoBrittle_outputID !< ID of each post result output
type, private :: tParameters !< container type for internal constitutive parameters
real(pReal) :: &
aTol, &
sdot_0, &
N
real(pReal), dimension(:), allocatable :: &
critDisp, &
critLoad
integer(pInt) :: &
totalNcleavage
integer(pInt), dimension(:), allocatable :: &
Ncleavage
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID !< ID of each post result output
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -62,30 +62,24 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoBrittle_init(fileUnit)
subroutine source_damage_anisoBrittle_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
IO_error
use math, only: &
math_expand
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
@ -94,35 +88,34 @@ subroutine source_damage_anisoBrittle_init(fileUnit)
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator
use lattice, only: &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
lattice_maxNcleavageFamily
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p ,i
integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::]
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoBrittle_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
character(len=pStringLen) :: &
extmsg = ''
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>'
#include "compilation_info.f90"
maxNinstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt)
if (maxNinstance == 0_pInt) return
Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt)
if (Ninstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0_pInt)
allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt)
@ -133,160 +126,89 @@ subroutine source_damage_anisoBrittle_init(fileUnit)
source_damage_anisoBrittle_offset(phase) = source
enddo
enddo
allocate(source_damage_anisoBrittle_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),maxNinstance))
source_damage_anisoBrittle_output = ''
allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_anisoBrittle_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_totalNcleavage(maxNinstance), source=0_pInt)
allocate(source_damage_anisoBrittle_aTol(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_sdot_0(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoBrittle_N(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = source_damage_anisoBrittle_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('anisobrittle_drivingforce')
source_damage_anisoBrittle_Noutput(instance) = source_damage_anisoBrittle_Noutput(instance) + 1_pInt
source_damage_anisoBrittle_outputID(source_damage_anisoBrittle_Noutput(instance),instance) = damage_drivingforce_ID
source_damage_anisoBrittle_output(source_damage_anisoBrittle_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt)
allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance))
source_damage_anisoBrittle_output = ''
case ('anisobrittle_atol')
source_damage_anisoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('anisobrittle_sdot0')
source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('anisobrittle_ratesensitivity')
source_damage_anisoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('ncleavage') !
Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt
do j = 1_pInt, Nchunks_CleavageFamilies
source_damage_anisoBrittle_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j)
enddo
allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt)
case ('anisobrittle_criticaldisplacement')
do j = 1_pInt, Nchunks_CleavageFamilies
source_damage_anisoBrittle_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
allocate(param(Ninstance))
do p=1, size(config_phase)
if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle
associate(prm => param(source_damage_anisoBrittle_instance(p)), &
config => config_phase(p))
prm%aTol = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal)
case ('anisobrittle_criticalload')
do j = 1_pInt, Nchunks_CleavageFamilies
source_damage_anisoBrittle_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
prm%N = config%getFloat('anisobrittle_ratesensitivity')
prm%sdot_0 = config%getFloat('anisobrittle_sdot0')
! sanity checks
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol'
if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity'
if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0'
prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray)
prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage))
prm%critLoad = config%getFloats('anisobrittle_criticalload', requiredSize=size(prm%Ncleavage))
! expand: family => system
prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage)
prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage)
if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticalload'
if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement'
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('anisobrittle_drivingforce')
source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1_pInt
source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
end select
endif; endif
enddo parsingFile
!--------------------------------------------------------------------------------------------------
! sanity checks
sanityChecks: do phase = 1_pInt, material_Nphase
myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then
instance = source_damage_anisoBrittle_instance(phase)
source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance) = &
min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested
source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance))
source_damage_anisoBrittle_totalNcleavage(instance) = sum(source_damage_anisoBrittle_Ncleavage(:,instance)) ! how many cleavage systems altogether
if (source_damage_anisoBrittle_aTol(instance) < 0.0_pReal) &
source_damage_anisoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3
if (source_damage_anisoBrittle_sdot_0(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoBrittle_LABEL//')')
if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')')
if (any(source_damage_anisoBrittle_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//SOURCE_damage_anisoBrittle_LABEL//')')
if (source_damage_anisoBrittle_N(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoBrittle_LABEL//')')
endif myPhase
enddo sanityChecks
enddo
end associate
phase = p
NofMyPhase=count(material_phase==phase)
instance = source_damage_anisoBrittle_instance(phase)
sourceOffset = source_damage_anisoBrittle_offset(phase)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage
enddo
initializeInstances: do phase = 1_pInt, material_Nphase
if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then
NofMyPhase=count(material_phase==phase)
instance = source_damage_anisoBrittle_instance(phase)
sourceOffset = source_damage_anisoBrittle_offset(phase)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance)
select case(source_damage_anisoBrittle_outputID(o,instance))
case(damage_drivingforce_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
source_damage_anisoBrittle_sizePostResult(o,instance) = mySize
source_damage_anisoBrittle_sizePostResults(instance) = source_damage_anisoBrittle_sizePostResults(instance) + mySize
endif
enddo outputsLoop
!--------------------------------------------------------------------------------------------------
! Determine size of state array
sizeDotState = 1_pInt
sizeDeltaState = 0_pInt
sizeState = 1_pInt
sourceState(phase)%p(sourceOffset)%sizeState = sizeState
sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState
sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState
sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance)
allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), &
source=source_damage_anisoBrittle_aTol(instance))
allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
endif
enddo initializeInstances
end subroutine source_damage_anisoBrittle_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el)
subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
use math, only: &
math_mul33xx33
use material, only: &
phaseAt, phasememberAt, &
sourceState, &
@ -294,7 +216,7 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el)
damage, &
damageMapping
use lattice, only: &
lattice_Scleavage_v, &
lattice_Scleavage, &
lattice_maxNcleavageFamily, &
lattice_NcleavageSystem
@ -303,8 +225,8 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el)
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), intent(in), dimension(6) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel)
real(pReal), intent(in), dimension(3,3) :: &
S
integer(pInt) :: &
phase, &
constituent, &
@ -312,7 +234,7 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el)
sourceOffset, &
damageOffset, &
homog, &
f, i, index_myFamily
f, i, index_myFamily, index
real(pReal) :: &
traction_d, traction_t, traction_n, traction_crit
@ -324,23 +246,26 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el)
damageOffset = damageMapping(homog)%p(ip,el)
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
index = 1_pInt
do f = 1_pInt,lattice_maxNcleavageFamily
index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family
do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family
traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase))
traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase))
traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase))
index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family
do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family
traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase))
traction_crit = source_damage_anisoBrittle_critLoad(f,instance)* &
traction_crit = param(instance)%critLoad(index)* &
damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset)
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + &
source_damage_anisoBrittle_sdot_0(instance)* &
((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + &
(max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + &
(max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance))/ &
source_damage_anisoBrittle_critDisp(f,instance)
param(instance)%sdot_0* &
((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + &
(max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + &
(max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ &
param(instance)%critDisp(index)
index = index + 1_pInt
enddo
enddo
@ -349,30 +274,26 @@ end subroutine source_damage_anisoBrittle_dotState
!--------------------------------------------------------------------------------------------------
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el)
subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
phase, &
constituent
real(pReal), intent(in) :: &
phi
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
phase, constituent, sourceOffset
sourceOffset
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
sourceOffset = source_damage_anisoBrittle_offset(phase)
localphiDot = 1.0_pReal - &
sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi
localphiDot = 1.0_pReal &
- sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi
dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
@ -381,33 +302,28 @@ end subroutine source_damage_anisobrittle_getRateAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_anisoBrittle_postResults(ipc,ip,el)
function source_damage_anisoBrittle_postResults(phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(source_damage_anisoBrittle_sizePostResults( &
source_damage_anisoBrittle_instance(phaseAt(ipc,ip,el)))) :: &
integer(pInt), intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, &
source_damage_anisoBrittle_instance(phase)))) :: &
source_damage_anisoBrittle_postResults
integer(pInt) :: &
instance, phase, constituent, sourceOffset, o, c
instance, sourceOffset, o, c
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_anisoBrittle_instance(phase)
sourceOffset = source_damage_anisoBrittle_offset(phase)
c = 0_pInt
source_damage_anisoBrittle_postResults = 0.0_pReal
do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance)
select case(source_damage_anisoBrittle_outputID(o,instance))
do o = 1_pInt,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_anisoBrittle_postResults(c+1_pInt) = &
sourceState(phase)%p(sourceOffset)%state(1,constituent)

336
src/source_damage_anisoDuctile.f90
View File

@ -12,7 +12,6 @@ module source_damage_anisoDuctile
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_anisoDuctile_sizePostResults, & !< cumulative size of post results
source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_anisoDuctile_instance !< instance of damage source mechanism
@ -22,35 +21,31 @@ module source_damage_anisoDuctile
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_anisoDuctile_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_anisoDuctile_Noutput !< number of outputs per instance of this damage
integer(pInt), dimension(:), allocatable, private :: &
source_damage_anisoDuctile_totalNslip !< total number of slip systems
integer(pInt), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_Nslip !< number of slip systems per family
real(pReal), dimension(:), allocatable, private :: &
source_damage_anisoDuctile_aTol
real(pReal), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_critPlasticStrain
real(pReal), dimension(:), allocatable, private :: &
source_damage_anisoDuctile_sdot_0, &
source_damage_anisoDuctile_N
real(pReal), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_critLoad
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_anisoDuctile_outputID !< ID of each post result output
type, private :: tParameters !< container type for internal constitutive parameters
real(pReal) :: &
aTol, &
N
real(pReal), dimension(:), allocatable :: &
critPlasticStrain
integer(pInt) :: &
totalNslip
integer(pInt), dimension(:), allocatable :: &
Nslip
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -66,30 +61,24 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_init(fileUnit)
subroutine source_damage_anisoDuctile_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
IO_error
use math, only: &
math_expand
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
@ -98,35 +87,35 @@ subroutine source_damage_anisoDuctile_init(fileUnit)
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem
lattice_maxNslipFamily
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p ,i
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoDuctile_LABEL//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::]
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
character(len=pStringLen) :: &
extmsg = ''
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>'
#include "compilation_info.f90"
maxNinstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt)
if (maxNinstance == 0_pInt) return
Ninstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt)
if (Ninstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(source_damage_anisoDuctile_offset(material_Nphase), source=0_pInt)
allocate(source_damage_anisoDuctile_instance(material_Nphase), source=0_pInt)
@ -138,151 +127,75 @@ subroutine source_damage_anisoDuctile_init(fileUnit)
enddo
enddo
allocate(source_damage_anisoDuctile_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),maxNinstance))
allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance))
source_damage_anisoDuctile_output = ''
allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_anisoDuctile_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal)
allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_totalNslip(maxNinstance), source=0_pInt)
allocate(source_damage_anisoDuctile_N(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoDuctile_sdot_0(maxNinstance), source=0.0_pReal)
allocate(source_damage_anisoDuctile_aTol(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt)
allocate(param(Ninstance))
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = source_damage_anisoDuctile_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('anisoductile_drivingforce')
source_damage_anisoDuctile_Noutput(instance) = source_damage_anisoDuctile_Noutput(instance) + 1_pInt
source_damage_anisoDuctile_outputID(source_damage_anisoDuctile_Noutput(instance),instance) = damage_drivingforce_ID
source_damage_anisoDuctile_output(source_damage_anisoDuctile_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
do p=1, size(config_phase)
if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISODUCTILE_ID)) cycle
associate(prm => param(source_damage_anisoDuctile_instance(p)), &
config => config_phase(p))
prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal)
case ('anisoductile_atol')
source_damage_anisoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('nslip') !
Nchunks_SlipFamilies = chunkPos(1) - 1_pInt
do j = 1_pInt, Nchunks_SlipFamilies
source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j)
enddo
prm%N = config%getFloat('anisoductile_ratesensitivity')
! sanity checks
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol'
if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity'
prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray)
prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(prm%Nslip))
case ('anisoductile_sdot0')
source_damage_anisoDuctile_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('anisoductile_criticalplasticstrain')
do j = 1_pInt, Nchunks_SlipFamilies
source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
case ('anisoductile_ratesensitivity')
source_damage_anisoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt)
! expand: family => system
prm%critPlasticStrain = math_expand(prm%critPlasticStrain, prm%Nslip)
if (any(prm%critPlasticStrain < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_criticalplasticstrain'
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('anisoductile_drivingforce')
source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1_pInt
source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
case ('anisoductile_criticalload')
do j = 1_pInt, Nchunks_SlipFamilies
source_damage_anisoDuctile_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j)
enddo
end select
endif; endif
enddo parsingFile
!--------------------------------------------------------------------------------------------------
! sanity checks
sanityChecks: do phase = 1_pInt, size(phase_source)
myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then
instance = source_damage_anisoDuctile_instance(phase)
source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance) = &
min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested
source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance))
source_damage_anisoDuctile_totalNslip(instance) = sum(source_damage_anisoDuctile_Nslip(:,instance))
if (source_damage_anisoDuctile_aTol(instance) < 0.0_pReal) &
source_damage_anisoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3
if (source_damage_anisoDuctile_sdot_0(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoDuctile_LABEL//')')
if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) &
call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')')
if (source_damage_anisoDuctile_N(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoDuctile_LABEL//')')
endif myPhase
enddo sanityChecks
enddo
end associate
phase = p
NofMyPhase=count(material_phase==phase)
instance = source_damage_anisoDuctile_instance(phase)
sourceOffset = source_damage_anisoDuctile_offset(phase)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
source_damage_anisoDuctile_Nslip(1:size(param(instance)%Nslip),instance) = param(instance)%Nslip
enddo
initializeInstances: do phase = 1_pInt, material_Nphase
if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then
NofMyPhase=count(material_phase==phase)
instance = source_damage_anisoDuctile_instance(phase)
sourceOffset = source_damage_anisoDuctile_offset(phase)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance)
select case(source_damage_anisoDuctile_outputID(o,instance))
case(damage_drivingforce_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
source_damage_anisoDuctile_sizePostResult(o,instance) = mySize
source_damage_anisoDuctile_sizePostResults(instance) = source_damage_anisoDuctile_sizePostResults(instance) + mySize
endif
enddo outputsLoop
!--------------------------------------------------------------------------------------------------
! Determine size of state array
sizeDotState = 1_pInt
sizeDeltaState = 0_pInt
sizeState = 1_pInt
sourceState(phase)%p(sourceOffset)%sizeState = sizeState
sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState
sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState
sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance)
allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), &
source=source_damage_anisoDuctile_aTol(instance))
allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
endif
enddo initializeInstances
end subroutine source_damage_anisoDuctile_init
!--------------------------------------------------------------------------------------------------
@ -326,8 +239,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + &
plasticState(phase)%slipRate(index,constituent)/ &
((damage(homog)%p(damageOffset))**source_damage_anisoDuctile_N(instance))/ &
source_damage_anisoDuctile_critPlasticStrain(f,instance)
((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(index)
index = index + 1_pInt
enddo
@ -338,31 +250,26 @@ end subroutine source_damage_anisoDuctile_dotState
!--------------------------------------------------------------------------------------------------
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el)
subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
phase, &
constituent
real(pReal), intent(in) :: &
phi
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
phase, constituent, sourceOffset
sourceOffset
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
sourceOffset = source_damage_anisoDuctile_offset(phase)
localphiDot = 1.0_pReal - &
sourceState(phase)%p(sourceOffset)%state(1,constituent)* &
phi
localphiDot = 1.0_pReal &
- sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi
dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
@ -371,33 +278,28 @@ end subroutine source_damage_anisoDuctile_getRateAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_anisoDuctile_postResults(ipc,ip,el)
function source_damage_anisoDuctile_postResults(phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(source_damage_anisoDuctile_sizePostResults( &
source_damage_anisoDuctile_instance(phaseAt(ipc,ip,el)))) :: &
integer(pInt), intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, &
source_damage_anisoDuctile_instance(phase)))) :: &
source_damage_anisoDuctile_postResults
integer(pInt) :: &
instance, phase, constituent, sourceOffset, o, c
instance, sourceOffset, o, c
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_anisoDuctile_instance(phase)
sourceOffset = source_damage_anisoDuctile_offset(phase)
c = 0_pInt
source_damage_anisoDuctile_postResults = 0.0_pReal
do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance)
select case(source_damage_anisoDuctile_outputID(o,instance))
do o = 1_pInt,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_anisoDuctile_postResults(c+1_pInt) = &
sourceState(phase)%p(sourceOffset)%state(1,constituent)

297
src/source_damage_isoBrittle.f90
View File

@ -12,7 +12,6 @@ module source_damage_isoBrittle
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_isoBrittle_sizePostResults, & !< cumulative size of post results
source_damage_isoBrittle_offset, & !< which source is my current damage mechanism?
source_damage_isoBrittle_instance !< instance of damage source mechanism
@ -21,22 +20,23 @@ module source_damage_isoBrittle
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_isoBrittle_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_damage_isoBrittle_aTol, &
source_damage_isoBrittle_N, &
source_damage_isoBrittle_critStrainEnergy
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_isoBrittle_outputID !< ID of each post result output
type, private :: tParameters !< container type for internal constitutive parameters
real(pReal) :: &
critStrainEnergy, &
N, &
aTol
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -52,30 +52,22 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_init(fileUnit)
subroutine source_damage_isoBrittle_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
IO_error
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
@ -84,31 +76,31 @@ subroutine source_damage_isoBrittle_init(fileUnit)
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p,i
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoBrittle_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
character(len=pStringLen) :: &
extmsg = ''
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'
#include "compilation_info.f90"
maxNinstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt)
if (maxNinstance == 0_pInt) return
Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt)
if (Ninstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(source_damage_isoBrittle_offset(material_Nphase), source=0_pInt)
allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt)
@ -120,121 +112,64 @@ subroutine source_damage_isoBrittle_init(fileUnit)
enddo
enddo
allocate(source_damage_isoBrittle_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),maxNinstance))
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance))
source_damage_isoBrittle_output = ''
allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_isoBrittle_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_isoBrittle_critStrainEnergy(maxNinstance), source=0.0_pReal)
allocate(source_damage_isoBrittle_N(maxNinstance), source=1.0_pReal)
allocate(source_damage_isoBrittle_aTol(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
allocate(param(Ninstance))
do p=1, size(config_phase)
if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISOBRITTLE_ID)) cycle
associate(prm => param(source_damage_isoBrittle_instance(p)), &
config => config_phase(p))
prm%aTol = config%getFloat('isobrittle_atol',defaultVal = 1.0e-3_pReal)
prm%N = config%getFloat('isobrittle_n')
prm%critStrainEnergy = config%getFloat('isobrittle_criticalstrainenergy')
! sanity checks
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_atol'
if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n'
if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy'
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('isobrittle_drivingforce')
source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1_pInt
source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
end select
enddo
end associate
phase = p
NofMyPhase=count(material_phase==phase)
instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase)
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,1_pInt)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = source_damage_isoBrittle_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('isobrittle_drivingforce')
source_damage_isoBrittle_Noutput(instance) = source_damage_isoBrittle_Noutput(instance) + 1_pInt
source_damage_isoBrittle_outputID(source_damage_isoBrittle_Noutput(instance),instance) = damage_drivingforce_ID
source_damage_isoBrittle_output(source_damage_isoBrittle_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
case ('isobrittle_criticalstrainenergy')
source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('isobrittle_n')
source_damage_isoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('isobrittle_atol')
source_damage_isoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif; endif
enddo parsingFile
!--------------------------------------------------------------------------------------------------
! sanity checks
sanityChecks: do phase = 1_pInt, material_Nphase
myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then
instance = source_damage_isoBrittle_instance(phase)
if (source_damage_isoBrittle_aTol(instance) < 0.0_pReal) &
source_damage_isoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3
if (source_damage_isoBrittle_critStrainEnergy(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='criticalStrainEnergy ('//SOURCE_damage_isoBrittle_LABEL//')')
endif myPhase
enddo sanityChecks
initializeInstances: do phase = 1_pInt, material_Nphase
if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then
NofMyPhase=count(material_phase==phase)
instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,source_damage_isoBrittle_Noutput(instance)
select case(source_damage_isoBrittle_outputID(o,instance))
case(damage_drivingforce_ID)
mySize = 1_pInt
end select
if (mySize > 0_pInt) then ! any meaningful output found
source_damage_isoBrittle_sizePostResult(o,instance) = mySize
source_damage_isoBrittle_sizePostResults(instance) = source_damage_isoBrittle_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! Determine size of state array
sizeDotState = 1_pInt
sizeDeltaState = 1_pInt
sizeState = 1_pInt
sourceState(phase)%p(sourceOffset)%sizeState = sizeState
sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState
sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState
sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance)
allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), &
source=source_damage_isoBrittle_aTol(instance))
allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
endif
enddo initializeInstances
end subroutine source_damage_isoBrittle_init
!--------------------------------------------------------------------------------------------------
@ -243,15 +178,11 @@ end subroutine source_damage_isoBrittle_init
subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
sourceState, &
material_homog, &
phase_NstiffnessDegradations, &
phase_stiffnessDegradation
sourceState
use math, only : &
math_sym33to6, &
math_mul33x33, &
math_mul66x6, &
math_Mandel33to6, &
math_transpose33, &
math_I3
implicit none
@ -264,10 +195,9 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
real(pReal), intent(in), dimension(6,6) :: &
C
integer(pInt) :: &
phase, constituent, instance, sourceOffset, mech
phase, constituent, instance, sourceOffset
real(pReal) :: &
strain(6), &
stiffness(6,6), &
strainenergy
phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el
@ -276,11 +206,11 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source
sourceOffset = source_damage_isoBrittle_offset(phase)
stiffness = C
strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3)
strain = 0.5_pReal*math_sym33to6(math_mul33x33(transpose(Fe),Fe)-math_I3)
strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ &
source_damage_isoBrittle_critStrainEnergy(instance)
strainenergy = 2.0_pReal*sum(strain*math_mul66x6(C,strain))/param(instance)%critStrainEnergy
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)
@ -295,33 +225,29 @@ end subroutine source_damage_isoBrittle_deltaState
!--------------------------------------------------------------------------------------------------
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el)
subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
phase, &
constituent
real(pReal), intent(in) :: &
phi
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
phase, constituent, instance, sourceOffset
instance, sourceOffset
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase)
localphiDot = (1.0_pReal - phi)**(source_damage_isoBrittle_N(instance) - 1.0_pReal) - &
localphiDot = (1.0_pReal - phi)**(param(instance)%N - 1.0_pReal) - &
phi*sourceState(phase)%p(sourceOffset)%state(1,constituent)
dLocalphiDot_dPhi = - (source_damage_isoBrittle_N(instance) - 1.0_pReal)* &
(1.0_pReal - phi)**max(0.0_pReal,source_damage_isoBrittle_N(instance) - 2.0_pReal) &
dLocalphiDot_dPhi = - (param(instance)%N - 1.0_pReal)* &
(1.0_pReal - phi)**max(0.0_pReal,param(instance)%N - 2.0_pReal) &
- sourceState(phase)%p(sourceOffset)%state(1,constituent)
end subroutine source_damage_isoBrittle_getRateAndItsTangent
@ -329,33 +255,28 @@ end subroutine source_damage_isoBrittle_getRateAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_isoBrittle_postResults(ipc,ip,el)
function source_damage_isoBrittle_postResults(phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(source_damage_isoBrittle_sizePostResults( &
source_damage_isoBrittle_instance(phaseAt(ipc,ip,el)))) :: &
integer(pInt), intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, &
source_damage_isoBrittle_instance(phase)))) :: &
source_damage_isoBrittle_postResults
integer(pInt) :: &
instance, phase, constituent, sourceOffset, o, c
instance, sourceOffset, o, c
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase)
c = 0_pInt
source_damage_isoBrittle_postResults = 0.0_pReal
do o = 1_pInt,source_damage_isoBrittle_Noutput(instance)
select case(source_damage_isoBrittle_outputID(o,instance))
do o = 1_pInt,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_isoBrittle_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
c = c + 1

263
src/source_damage_isoDuctile.f90
View File

@ -12,7 +12,6 @@ module source_damage_isoDuctile
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
source_damage_isoDuctile_sizePostResults, & !< cumulative size of post results
source_damage_isoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_isoDuctile_instance !< instance of damage source mechanism
@ -21,22 +20,23 @@ module source_damage_isoDuctile
character(len=64), dimension(:,:), allocatable, target, public :: &
source_damage_isoDuctile_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage
real(pReal), dimension(:), allocatable, private :: &
source_damage_isoDuctile_aTol, &
source_damage_isoDuctile_critPlasticStrain, &
source_damage_isoDuctile_N
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
source_damage_isoDuctile_outputID !< ID of each post result output
type, private :: tParameters !< container type for internal constitutive parameters
real(pReal) :: &
critPlasticStrain, &
N, &
aTol
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
end type tParameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
public :: &
@ -52,30 +52,23 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_init(fileUnit)
subroutine source_damage_isoDuctile_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use debug, only: &
debug_level,&
debug_constitutive,&
debug_levelBasic
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_warning, &
IO_error, &
IO_timeStamp, &
IO_EOF
IO_error
use material, only: &
material_allocateSourceState, &
phase_source, &
phase_Nsources, &
phase_Noutput, &
@ -84,32 +77,31 @@ subroutine source_damage_isoDuctile_init(fileUnit)
material_phase, &
sourceState
use config, only: &
config_phase, &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o
integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
integer(pInt) :: NofMyPhase
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
integer(pInt) :: NofMyPhase,p,i
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
outputID
write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoDuctile_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
character(len=pStringLen) :: &
extmsg = ''
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>'
#include "compilation_info.f90"
maxNinstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt)
if (maxNinstance == 0_pInt) return
Ninstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt)
if (Ninstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt)
allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt)
@ -121,121 +113,64 @@ subroutine source_damage_isoDuctile_init(fileUnit)
enddo
enddo
allocate(source_damage_isoDuctile_sizePostResults(maxNinstance), source=0_pInt)
allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),maxNinstance))
allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance))
source_damage_isoDuctile_output = ''
allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
allocate(source_damage_isoDuctile_Noutput(maxNinstance), source=0_pInt)
allocate(source_damage_isoDuctile_critPlasticStrain(maxNinstance), source=0.0_pReal)
allocate(source_damage_isoDuctile_N(maxNinstance), source=0.0_pReal)
allocate(source_damage_isoDuctile_aTol(maxNinstance), source=0.0_pReal)
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
allocate(param(Ninstance))
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = source_damage_isoDuctile_instance(phase) ! which instance of my damage is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('isoductile_drivingforce')
source_damage_isoDuctile_Noutput(instance) = source_damage_isoDuctile_Noutput(instance) + 1_pInt
source_damage_isoDuctile_outputID(source_damage_isoDuctile_Noutput(instance),instance) = damage_drivingforce_ID
source_damage_isoDuctile_output(source_damage_isoDuctile_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
end select
do p=1, size(config_phase)
if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISODUCTILE_ID)) cycle
associate(prm => param(source_damage_isoDuctile_instance(p)), &
config => config_phase(p))
prm%aTol = config%getFloat('isoductile_atol',defaultVal = 1.0e-3_pReal)
case ('isoductile_criticalplasticstrain')
source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,chunkPos,2_pInt)
prm%N = config%getFloat('isoductile_ratesensitivity')
prm%critPlasticStrain = config%getFloat('isoductile_criticalplasticstrain')
! sanity checks
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isoductile_atol'
if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_ratesensitivity'
if (prm%critPlasticStrain <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_criticalplasticstrain'
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')')
case ('isoductile_ratesensitivity')
source_damage_isoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt)
case ('isoductile_atol')
source_damage_isoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt)
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
outputID = undefined_ID
select case(outputs(i))
case ('isoductile_drivingforce')
source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1_pInt
source_damage_isoDuctile_output(i,source_damage_isoDuctile_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID]
end select
endif; endif
enddo parsingFile
enddo
!--------------------------------------------------------------------------------------------------
! sanity checks
sanityChecks: do phase = 1_pInt, material_Nphase
myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then
instance = source_damage_isoDuctile_instance(phase)
if (source_damage_isoDuctile_aTol(instance) < 0.0_pReal) &
source_damage_isoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3
if (source_damage_isoDuctile_critPlasticStrain(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='critical plastic strain ('//SOURCE_damage_isoDuctile_LABEL//')')
endif myPhase
enddo sanityChecks
end associate
phase = p
NofMyPhase=count(material_phase==phase)
instance = source_damage_isoDuctile_instance(phase)
sourceOffset = source_damage_isoDuctile_offset(phase)
initializeInstances: do phase = 1_pInt, material_Nphase
if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then
NofMyPhase=count(material_phase==phase)
instance = source_damage_isoDuctile_instance(phase)
sourceOffset = source_damage_isoDuctile_offset(phase)
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,source_damage_isoDuctile_Noutput(instance)
select case(source_damage_isoDuctile_outputID(o,instance))
case(damage_drivingforce_ID)
mySize = 1_pInt
end select
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance))
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
if (mySize > 0_pInt) then ! any meaningful output found
source_damage_isoDuctile_sizePostResult(o,instance) = mySize
source_damage_isoDuctile_sizePostResults(instance) = source_damage_isoDuctile_sizePostResults(instance) + mySize
endif
enddo outputsLoop
! Determine size of state array
sizeDotState = 1_pInt
sizeDeltaState = 0_pInt
sizeState = 1_pInt
sourceState(phase)%p(sourceOffset)%sizeState = sizeState
sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState
sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState
sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance)
allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), &
source=source_damage_isoDuctile_aTol(instance))
allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 1_pInt)) then
allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal)
allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal)
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal)
if (any(numerics_integrator == 5_pInt)) &
allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
endif
enddo
enddo initializeInstances
end subroutine source_damage_isoDuctile_init
!--------------------------------------------------------------------------------------------------
@ -267,39 +202,34 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
sum(plasticState(phase)%slipRate(:,constituent))/ &
((damage(homog)%p(damageOffset))**source_damage_isoDuctile_N(instance))/ &
source_damage_isoDuctile_critPlasticStrain(instance)
((damage(homog)%p(damageOffset))**param(instance)%N)/ &
param(instance)%critPlasticStrain
end subroutine source_damage_isoDuctile_dotState
!--------------------------------------------------------------------------------------------------
!> @brief returns local part of nonlocal damage driving force
!--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el)
subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
phase, &
constituent
real(pReal), intent(in) :: &
phi
real(pReal), intent(out) :: &
localphiDot, &
dLocalphiDot_dPhi
integer(pInt) :: &
phase, constituent, sourceOffset
sourceOffset
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
sourceOffset = source_damage_isoDuctile_offset(phase)
localphiDot = 1.0_pReal - &
sourceState(phase)%p(sourceOffset)%state(1,constituent)* &
phi
localphiDot = 1.0_pReal &
- sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi
dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
@ -308,33 +238,28 @@ end subroutine source_damage_isoDuctile_getRateAndItsTangent
!--------------------------------------------------------------------------------------------------
!> @brief return array of local damage results
!--------------------------------------------------------------------------------------------------
function source_damage_isoDuctile_postResults(ipc,ip,el)
function source_damage_isoDuctile_postResults(phase, constituent)
use material, only: &
phaseAt, phasememberAt, &
sourceState
implicit none
integer(pInt), intent(in) :: &
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(source_damage_isoDuctile_sizePostResults( &
source_damage_isoDuctile_instance(phaseAt(ipc,ip,el)))) :: &
integer(pInt), intent(in) :: &
phase, &
constituent
real(pReal), dimension(sum(source_damage_isoDuctile_sizePostResult(:, &
source_damage_isoDuctile_instance(phase)))) :: &
source_damage_isoDuctile_postResults
integer(pInt) :: &
instance, phase, constituent, sourceOffset, o, c
instance, sourceOffset, o, c
phase = phaseAt(ipc,ip,el)
constituent = phasememberAt(ipc,ip,el)
instance = source_damage_isoDuctile_instance(phase)
sourceOffset = source_damage_isoDuctile_offset(phase)
c = 0_pInt
source_damage_isoDuctile_postResults = 0.0_pReal
do o = 1_pInt,source_damage_isoDuctile_Noutput(instance)
select case(source_damage_isoDuctile_outputID(o,instance))
do o = 1_pInt,size(param(instance)%outputID)
select case(param(instance)%outputID(o))
case (damage_drivingforce_ID)
source_damage_isoDuctile_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
c = c + 1

148
src/system_routines.f90
View File

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