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

Merge branch 'MiscImprovements' into development

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

46
.gitlab-ci.yml
View File

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

10
CMakeLists.txt
View File

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

2
PRIVATE

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

5
installation/mods_Abaqus/abaqus_v6.env
View File

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

5
installation/mods_Abaqus/abaqus_v6_debug.env
View File

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

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

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

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

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

24
processing/post/addOrientations.py
View File

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

7
processing/post/rotateData.py
View File

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

2
processing/post/sortTable.py
View File

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

3
processing/post/vtk_addGridData.py
View File

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

3
processing/post/vtk_addPointCloudData.py
View File

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

3
processing/post/vtk_addRectilinearGridData.py
View File

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

32
processing/pre/geom_addPrimitive.py
View File

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

73
python/damask/util.py
View File

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

2
src/CMakeLists.txt
View File

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

264
src/CPFEM.f90
View File

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

34
src/CPFEM2.f90
View File

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

10
src/DAMASK_FEM.f90
View File

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

29
src/DAMASK_abaqus.f
View File

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

70
src/DAMASK_interface.f90
View File

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

31
src/DAMASK_marc.f90
View File

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

6
src/DAMASK_spectral.f90
View File

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

4
src/FEM_mech.f90
View File

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

45
src/FEM_utilities.f90
View File

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

182
src/HDF5_utilities.f90
View File

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

445
src/IO.f90
View File

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

10
src/Lambert.f90
View File

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

1
src/commercialFEM_fileList.f90
View File

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

71
src/config.f90
View File

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

94
src/constitutive.f90
View File

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

87
src/crystallite.f90
View File

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

171
src/damage_local.f90
View File

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

74
src/damage_none.f90
View File

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

194
src/damage_nonlocal.f90
View File

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

42
src/debug.f90
View File

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

1649
src/element.f90
View File

File diff suppressed because it is too large Load Diff

121
src/homogenization.f90
View File

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

31
src/homogenization_RGC.f90
View File

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

12
src/homogenization_isostrain.f90
View File

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

92
src/homogenization_none.f90
View File

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

15
src/kinematics_cleavage_opening.f90
View File

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

168
src/kinematics_slipplane_opening.f90
View File

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

4
src/kinematics_thermal_expansion.f90
View File

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

280
src/lattice.f90
View File

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

58
src/material.f90
View File

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

140
src/math.f90
View File

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

15
src/mesh_FEM.f90
View File

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

13
src/mesh_abaqus.f90
View File

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

17
src/mesh_grid.f90
View File

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

15
src/mesh_marc.f90
View File

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

39
src/numerics.f90
View File

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

45
src/plastic_disloUCLA.f90
View File

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

66
src/plastic_dislotwin.f90
View File

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

49
src/plastic_isotropic.f90
View File

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

44
src/plastic_kinematichardening.f90
View File

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

73
src/plastic_nonlocal.f90
View File

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

23
src/plastic_phenopowerlaw.f90
View File

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

66
src/prec.f90
View File

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

12
src/quaternions.f90
View File

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

45
src/results.f90
View File

@ -13,35 +13,36 @@ module results
use PETSC use PETSC
#endif #endif
implicit none implicit none
private private
integer(HID_T), public, protected :: tempCoordinates, tempResults integer(HID_T), public, protected :: tempCoordinates, tempResults
integer(HID_T), private :: resultsFile, currentIncID, plist_id integer(HID_T), private :: resultsFile, currentIncID, plist_id
public :: & public :: &
results_init, & results_init, &
results_openJobFile, & results_openJobFile, &
results_closeJobFile, & results_closeJobFile, &
results_addIncrement, & results_addIncrement, &
results_addGroup, & results_addGroup, &
results_openGroup, & results_openGroup, &
results_writeVectorDataset, & results_writeVectorDataset, &
results_setLink, & results_setLink, &
results_removeLink results_removeLink
contains contains
subroutine results_init subroutine results_init
use, intrinsic :: & use DAMASK_interface, only: &
iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) getSolverJobName
use DAMASK_interface, only: &
getSolverJobName
implicit none
write(6,'(/,a)') ' <<<+- results init -+>>>' implicit none
#include "compilation_info.f90"
call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.)) write(6,'(/,a)') ' <<<+- results init -+>>>'
write(6,'(/,a)') ' Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017'
write(6,'(a)') ' https://doi.org/10.1007/s40192-018-0118-7'
call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.))
end subroutine results_init end subroutine results_init

28
src/rotations.f90
View File

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

13
src/source_damage_anisoBrittle.f90
View File

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

57
src/source_damage_anisoDuctile.f90
View File

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

9
src/source_damage_isoBrittle.f90
View File

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

18
src/source_damage_isoDuctile.f90
View File

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

5
src/source_thermal_dissipation.f90
View File

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

3
src/source_thermal_externalheat.f90
View File

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

285
src/spectral_damage.f90
View File

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

84
src/spectral_mech_Basic.f90
View File

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

101
src/spectral_mech_Polarisation.f90
View File

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

323
src/spectral_thermal.f90
View File

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

251
src/spectral_utilities.f90
View File

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

18
src/thermal_adiabatic.f90
View File

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

20
src/thermal_conduction.f90
View File

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

28
src/thermal_isothermal.f90
View File

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